扫描所有传入电子邮件 Outlook

Question

我有以下代码可以对收件箱中通过 Outlook 收到的每封带有特定主题的电子邮件执行某些操作。它可以工作，但如果多封电子邮件同时到达（即当 Outlook 重新查询我的电子邮件地址所基于的服务器时），它只会在最近收到的一封上运行以下代码。有什么建议么？

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

Answer 1

您可以在文件夹中的项目上运行代码。

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