扫描所有传入的电子邮件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