I'm having trouble with the ItemAdd event routine when it runs after a rule that calls another script has been executed. Specifically the ItemAdd routine is only in charge of marking as read what is added to the Inbox folder; then I have some rules and some of them call as many scripts, whom make checks on the subjects or bodies of the incoming mails and copy them to other subfolders or notd.
This is what I got to understand: when a mail arrives and falls into the conditions of a rule that calls a script, the script gets executed correctly and before the ItemAdd event, but then, when the ItemAdd routine starts, the error is "Run-time error '-2147221241 (80040107)': The Operation failed." and that's because the item suddely cease to exist, as I understood from a little debugging activity on the immediate window. I also tried to slow down one or both the scripts with a sort of "wait" function, but that doesn't work too.
A curious thing is that if I set a breakpoint in the script called by the rule and then I proceed stepping over line by line, also the ItemAdd routine gets executed correctly (I checked it also adding a breakpoint in the ItemAdd routine code) and I really don't know why, probably the debugger keeps the item object in memory (?)
I know that I could use a simple rule to mark the incoming mail as read, or use the NewMailEx event to do the same, and in fact they both works correctly, but there's a not less important drawback: using these solution I got no notification for the mails, nor the envelope icon on top of the outlook icon in Windows taskbar (and that's why also the rule option to display a Desktop alert doesn't completely fulfill my purpose) which I instead get with ItemAdd.
That's the code of my scripts:
Private WithEvents allItems As Outlook.Items
Set allItems = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
Private Sub allItems_ItemAdd(ByVal Item As Object)
Item.UnRead = False
Item.Save
End Sub
Public Sub Rule_AboutAorB(ByVal Item As Object)
Dim copiedItem As Object
Dim colRules As Outlook.Rules
Dim oRule As Outlook.Rule
Dim oRuleAction As Outlook.RuleAction
Set colRules = Application.Session.DefaultStore.GetRules()
Dim AFlag As Boolean
Dim BFlag As Boolean
AFlag = False
BFlag = False
With CreateObject("VBScript.RegExp")
.Global = True
.IgnoreCase = True ' <-- case insensitve
.MultiLine = True
'A
.Pattern = "\b" & "A" & "\b"
If .Test(Item.Subject) Or .Test(Item.Body) Then
AFlag = True
End If
'B
.Pattern = "\b" & "B" & "\b"
If .Test(Item.Subject) Or .Test(Item.Body) Then
BFlag = True
End If
If AFlag = True Then
Set copiedItem = Item.Copy
copiedItem.UnRead = True
copiedItem.Move (Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Folders("A"))
Set oRule = colRules.Item("About A or B (VBA)")
oRule.Actions.Stop.Enabled = True
colRules.Save
ElseIf BFlag = True Then
Set copiedItem = Item.Copy
copiedItem.UnRead = True
copiedItem.Move (Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Folders("B"))
Set oRule = colRules.Item("About A or B (VBA)")
oRule.Actions.Stop.Enabled = True
colRules.Save
Else
Set oRule = colRules.Item("About A or B (VBA)")
oRule.Actions.Stop.Enabled = False
colRules.Save
End If
End With
Set copiedItem = Nothing
Set Item = Nothing ' This does not really change anything, I put it in a fixing attempt
End Sub
It may happen that another rule, which does not call a script, is executed, and then the ItemAdd routine runs, and in that case everything works smoothly, as I got the mail copied unread, the original one gets read and I also get the notification. Instead when this rule runs, it runs (correctly) before the ItemAdd routine, then the latter throws a runtime error when the Item is involved. I hope that some of you may help me to firstly understand the issue (why the item cease to exists) and then to fix the code so that I can still use the ItemAdd routine, hence getting the notifications.
I tried to use NewMailEx or another simple rule, but didn't get the notification. I tried to debug but then it works correctly, differently from a normal run. I ran out of options up to my VBA knowledge, which is kinda poor
The error is MAPI_E_INVALID_ENTRYID
, which makes sense - the item is gone, so its entry id is no longer valid. You have classic race condition. Not much you can do besides ignoring the error (on error resume next
).
BTW, you don't need to call Save
after setting the Unread
property.