Macro to move msg to folder when subject contains - vba

Question

I'm working with the code below. It works sometimes. I mean I can run test emails and it does what it supposed to do, but sometimes I get errors: The two errors I have gotten so far are: "Operation Failed. Object could not be found." And "Instant Search Not Enabled on Store." It appears to be random. My question is how can I enhance the code to make sure it runs without getting these errors??? I have the code programmed to fire every minute. Thanks
Option Explicit
Sub MoveItems()
Dim myNameSpace As Outlook.NameSpace
Dim myInbox As Outlook.Folder
Dim myDestFolderWA As Outlook.Folder
Dim myDestFolderOR As Outlook.Folder
Dim myDestFolderID As Outlook.Folder
Dim myItems As Outlook.Items
Dim myItemWA As Object
Dim myItemOR As Object
Dim myItemID As Object
Dim strFilter1 As String
Dim strFilter2 As String
Dim strFilter3 As String
Dim RestrictItems As Outlook.Items
Dim Mail As Outlook.MailItem
On Error GoTo ErrHandler
Set myNameSpace = Application.GetNamespace("MAPI")
Set myInbox = myNameSpace.Folders("Subpayables Invoices").Folders("Inbox")
Set myItems = myInbox.Items
Set myDestFolderWA = myInbox.Folders("WA")
Set myDestFolderOR = myInbox.Folders("OR")
Set myDestFolderID = myInbox.Folders("ID")
strFilter1 = "#SQL=" & Chr(34) _
& "urn:schemas:httpmail:subject" & Chr(34) _
& " ci_phrasematch 'washington'"
strFilter2 = "#SQL=" & Chr(34) _
& "urn:schemas:httpmail:subject" & Chr(34) _
& " ci_phrasematch 'oregon'"
strFilter3 = "#SQL=" & Chr(34) _
& "urn:schemas:httpmail:subject" & Chr(34) _
& " ci_phrasematch 'idaho'"
Set RestrictItems = myItems.Restrict(strFilter1)
Set myItemWA = RestrictItems.GetFirst
Set RestrictItems = myItems.Restrict(strFilter2)
Set myItemOR = RestrictItems.GetFirst
Set RestrictItems = myItems.Restrict(strFilter3)
Set myItemID = RestrictItems.GetFirst
While TypeName(myItemWA) <> "Nothing"
myItemWA.Move myDestFolderWA
Set myItemWA = RestrictItems.GetNext
Wend
While TypeName(myItemOR) <> "Nothing"
myItemOR.Move myDestFolderOR
Set myItemOR = RestrictItems.GetNext
Wend
While TypeName(myItemID) <> "Nothing"
myItemID.Move myDestFolderID
Set myItemID = RestrictItems.GetNext
Wend
Exit Sub
ErrHandler:
MsgBox Err & ": " & Error(Err)
End Sub

Answer 1

I am not getting any errors, but it is not doing what I want it to do
Did you try to debug the code and see what happens there? Do you get any errors?
The ItemAdd event of the Items class does not run when a large number of items are added to the folder at once (more than 16). This is a well-known issue. Is that the case?
You may consider handling the NewMailEx event of the Application class which is fired when a new item is received in the Inbox. Here is what MSDN states:
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. You should not assume that after these events fire, you will always get a one-item increase in the number of items in the Inbox.