Save email to a folder if subject line matches - vba

Question

I'm trying to save an email, when it arrives, into a folder if the subject line contains the right term.
This code would end up being copied for 75-80 items all with varying subject lines.
Option Explicit
Private Sub InboxItems_ItemAdd(ByVal objItem As Object)
Dim msgNew As MailItem
Dim DateYr As Object
Dim DateMonth As Object
If objItem.Class = olMail Then
Set msgNew = objItem
If (msgNew.Subject Like "Client Media Report*") Then
DateYr = Format(Now(), "yyyy", vbUseSystemDayOfWeek, vbUseSystem)
DateMonth = Format(Now(), "mm. mmmm", vbUseSystemDayOfWeek, vbUseSystem)
On Error Resume Next
MkDir "M:\AutoArchive\Client Media Report\" & DateYr
On Error GoTo 0
msgNew.SaveAs "M:\AutoArchive\Client Media Report\" & DateYr & "\" & DateMonth & ".msg"
End If
End If
End Sub
I'd expect this to save a new email into the correct folder. E.g., the example would save into M:\AutoArchive\Client Media Report\2019\08. August
It doesn't save and doesn't spit an error.
Example subject line: Client Media Report 05 August 2019
Example file location: M:\AutoArchive\Client Media Report\2019\08. August
EDIT: Updated with latest code, event triggers error
Unable to open item
on
Set mai = Application.Session.GetItemFromID(strEntryId)
Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
MsgBox ("Test1")
Dim mai As Object
Dim msgNew As MailItem
Dim DateYr As Object
Dim DateMonth As Object
Set mai = Application.Session.GetItemFromID(strEntryId)
MsgBox mai.Subject
If mai.Class = olMail Then
Set msgNew = objItem
If (msgNew.Subject Like "DPS Front Pages*") Then
DateYr = Format(Now(), "yyyy", vbUseSystemDayOfWeek, vbUseSystem)
DateMonth = Format(Now(), "mm. mmmm", vbUseSystemDayOfWeek, vbUseSystem)
On Error Resume Next
MkDir "D:\AutoArchive\Full Front Pages\" & DateYr
On Error GoTo 0
msgNew.SaveAs "D:\AutoArchive\Full Front Pages\" & DateYr & "\" & DateMonth & msgNew.Subject & ".msg"
End If
End If
End Sub

Answer 1

You need to handle the NewMailEx event of the Application class which is fired when a new item is received in the Inbox.
The NewMailEx event fires when a new message arrives in the Inbox and before client rule processing occurs. You can use the Entry ID returned in the EntryIDCollection array to call the NameSpace.GetItemFromID method and process the item. Use this method with caution to minimize the impact on Outlook performance. However, depending on the setup on the client computer, after a new message arrives in the Inbox, processes like spam filtering and client rules that move the new message from the Inbox to another folder can occur asynchronously.
Private Sub NewMailEx(ByVal EntryIDCollection As String)
Dim mai As Object
Dim msgNew As MailItem
Dim DateYr As Object
Dim DateMonth As Object
Set mai = Application.Session.GetItemFromID(strEntryId)
MsgBox mai.Subject
If mai.Class = olMail Then
Set msgNew = objItem
If (msgNew.Subject Like "Client Media Report*") Then
DateYr = Format(Now(), "yyyy", vbUseSystemDayOfWeek, vbUseSystem)
DateMonth = Format(Now(), "mm. mmmm", vbUseSystemDayOfWeek, vbUseSystem)
On Error Resume Next
MkDir "M:\AutoArchive\Client Media Report\" & DateYr
On Error GoTo 0
msgNew.SaveAs "M:\AutoArchive\Client Media Report\" & DateYr & "\" & DateMonth & msgNew.Subject & ".msg"
End If
End If
End Sub