vbaemaileventsoutlookrules

ItemAdd fails when rule copies an item and moves the copy


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.

  1. The ItemAdd routine to mark new Inbox item as read
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
  1. The script called by a rule (there's more than one rule but the behaviors are basically the same). Here the aim is to check for the presence of "A" or "B" and in that case move an unread copy to the right folder and stop the rules processing, otherwise continue executing the other rules in order.
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.


Solution

  • 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.