Scan All Incoming Emails Outlook

Question

I have the following code to do something on every email I receive via Outlook in the inbox with a specfic subject. It works but if multiple emails arrive at the same time (ie when Outlook re-queries the server my email address is based off of) it will only run the below code on the most recent one received. Any suggestions?

Private WithEvents Items As Outlook.Items

Private Sub Application_Startup()
  Dim olApp As Outlook.Application
  Dim objNS As Outlook.NameSpace
  Set olApp = Outlook.Application
  Set objNS = olApp.GetNamespace("MAPI")
  ' default local Inbox
  Set Items = objNS.GetDefaultFolder(olFolderInbox).Items
End Sub

Sub Items_ItemAdd(ByVal item As Object)
  On Error GoTo ErrorHandler
  Dim Msg As Outlook.MailItem
  If TypeName(item) = "MailItem" Then
    Set Msg = item
    If InStr(Msg.SentOnBehalfOfName, "name") <> 0 Then
        'Do Something
    End If
  End If
ProgramExit:
  Exit Sub
ErrorHandler:
  MsgBox Err.Number & " - " & Err.Description
  Resume ProgramExit
End Sub

niton niton · Accepted Answer · 2017-08-17T14:17:05

You could run the code on the items in the folder.

Sub Items_ItemAdd(ByVal item As Object)
    On Error GoTo ErrorHandler
    Dim Msg As Outlook.MailItem
    If TypeName(item) = "MailItem" Then
        Set Msg = item
        If InStr(Msg.SentOnBehalfOfName, "name") <> 0 Then
            'Do Something
            ' Move Msg to a "Done" folder
            '  or mark it read or some way
            '  you can use to not reprocess an item
        End If
    End If

    SkippedItems

ProgramExit:
    Exit Sub

ErrorHandler:
    MsgBox Err.Number & " - " & Err.Description
    Resume ProgramExit
End Sub


Sub SkippedItems

    dim i as long
    Dim skippedMsg As MailItem
    dim inboxItems as items
    dim inboxItemsCount as long

    On Error GoTo ErrorHandlerSkippedItems
    set inboxItems = session.GetDefaultFolder(olFolderInbox).Items
    inboxItemsCount = inboxItems.count

    if inboxItemsCount > 0 then

        for i = inboxItemsCount to 1 step -1

            If TypeName(inboxItems(i)) = "MailItem" Then
                Set skippedMsg = inboxItems(i)
                If InStr(skippedMsg.SentOnBehalfOfName, "name") <> 0 Then
                    'Do Something
                    ' Move SkippedMsg to a "Done" folder
                    '  or mark it read or some way
                    '  you can use to not reprocess an item

                    set skippedMsg = nothing
                End If
            End If
        Next

    End If

ProgramExitSkippedItems:
    set skippedMsg = nothing
    set inboxItems = nothing
    Exit Sub

ErrorHandlerSkippedItems:
    MsgBox Err.Number & " - " & Err.Description
    Resume ProgramExitSkippedItems
End Sub

Scan All Incoming Emails Outlook

1 Answers