扫描所有传入电子邮件Outlook

时间:2017-08-17 12:11:52

标签: vba email outlook outlook-vba

我有以下代码,可以在收件箱中通过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

1 个答案:

答案 0 :(得分:0)

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

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