I have an ItemAdd routine that marks as read what is added to the Inbox folder; then I have rules that call scripts which check the subjects or bodies of the incoming mails and copies then moves them to other subfolders.
This is what I understand: when a mail arrives and falls into the conditions of a rule that calls a script, the script gets executed 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 suddenly ceased to exist, as I understood from debugging activity on the immediate window.
I tried to slow down one or both the scripts with a sort of "wait" function but that didn't work.
If I set a breakpoint in the script called by the rule and then I step through line by line, the ItemAdd routine gets executed correctly, I checked it also adding a breakpoint in the ItemAdd routine code, probably the debugger keeps the item object in memory.
I could use a rule to mark the incoming mail as read, or use the NewMailEx event to do the same, and in fact they both work, but there's a drawback. Using these solutions 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.
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 want to first understand the issue (why the item ceases 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.
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.