Move Email with ItemAdd - vba

Question

I'm attempting to move email with specific subject when received.
The mail is still in my Inbox. I've tested by sending mail from my account with specific subject.
Option Explicit
Private WithEvents inboxItems As Outlook.Items
Private Sub Application_Startup()
Dim outlookApp As Outlook.Application
Dim objectNS As Outlook.NameSpace
Set outlookApp = Outlook.Application
Set objectNS = outlookApp.GetNamespace("MAPI")
Set inboxItems = objectNS.GetDefaultFolder(olFolderInbox).Items
End Sub
Private Sub Items_ItemAdd(ByVal item As Object)
On Error GoTo ErrorHandler
Dim Msg As Outlook.MailItem
Set myInbox = GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
If TypeName(item) = "MailItem" Then
Set Msg = item
If InStr(0, Msg.Subject, "Testing Subject", vbTextCompare) > 0 Then
Set fldr = Outlook.Session.GetDefaultFolder(olFolderInbox).Folders("Testing")
Msg.Move fldr
End If
End If
ProgramExit:
Exit Sub
ErrorHandler:
MsgBox Err.Number & " - " & Err.Description
Resume ProgramExit
End Sub
I created this macro in ThisOutlookSession.

Answer 1

I think you may have an error with the naming of your Sub which means it doesn't fire
Items_ItemAdd => inboxItems_ItemAdd
As an addendum: I recently implemented a RegEx filter to incoming e-mails as I found I couldn't easily use rules to filter out some junk e-mail coming my way. This should be able to adapted to your needs (I've added the rule I think should work for you, but it's untested)
Within the 'ThisOutlookSession'
Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
On Error Resume Next
Call RegExFilterRules(EntryIDCollection)
End Sub
Within a module
Sub RegExFilterRules(ItemID As String)
' Requires Reference: Microsoft Scripting Runtime
Dim ThisNamespace As Outlook.NameSpace: Set ThisNamespace = Application.GetNamespace("MAPI")
Dim Inbox As Outlook.MAPIFolder: Set Inbox = ThisNamespace.GetDefaultFolder(olFolderInbox)
Dim Junk As Outlook.MAPIFolder: Set Junk = ThisNamespace.GetDefaultFolder(olFolderJunk)
Dim oMsg As Outlook.MailItem: Set oMsg = ThisNamespace.GetItemFromID(ItemID, Inbox.StoreID)
If Not oMsg Is Nothing And oMsg.Class = olMail Then
'If FindPattern(oMsg.Subject, "^M\d+$") Then oMsg.Move Junk ' oMsg.Delete
If FindPattern(oMsg.Subject, "^Testing Subject") Then oMsg.Move Inbox.Folders("Testing")
End If
End Sub
Private Function FindPattern(Str As String, Pattern As String) As Boolean
Dim RegEx As Object: Set RegEx = CreateObject("vbscript.RegExp")
With RegEx
.Global = True
.IgnoreCase = True
.MultiLine = True
.Pattern = Pattern
FindPattern = .Test(Str)
End With
End Function