新电子邮件的事件侦听器以下载附件

Question

我想出这个来为新电子邮件创建一个事件监听器以下载附件。

我将How do I trigger a macro to run after a new mail is received in Outlook? 与https://www.extendoffice.com/documents/outlook/3747-outlook-auto-download-save-attachments-to-folder.html 结合在一起

我无法在 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
    On Error GoTo ErrorHandler
    Dim Msg As Outlook.MailItem
    If TypeName(item) = "MailItem" Then
        Set Msg = item
        Dim strSubject As String
        strSubject = Msg.Subject
        If InStr(0, strSubject, "VBA Test") > 0 Then
            Dim oAttachment As Outlook.Attachment
            Dim sSaveFolder As String
            sSaveFolder = "F:\Jason - DataCopies"
            For Each oAttachment In Msg.Attachments
                oAttachment.SaveAsFile sSaveFolder & oAttachment.DisplayName
            Next
        End If
    End If
ProgramExit:
    Exit Sub
ErrorHandler:
    MsgBox Err.Number & " - " & Err.Description
    Resume ProgramExit
End Sub

Answer 1

您似乎对Application 类的NewMailEx 事件感兴趣。对于 Microsoft Outlook 处理的每个收到的项目，此事件都会触发一次。该项目可以是几种不同的项目类型之一，例如MailItem、MeetingItem 或SharingItem。 EntryIDsCollection 字符串包含对应于该项目的条目 ID。

NewMailEx 事件在新邮件到达收件箱时以及在客户端规则处理发生之前触发。您可以使用EntryIDCollection 数组中返回的Entry ID 来调用NameSpace.GetItemFromID 方法并处理该项目。请谨慎使用此方法，以尽量减少对 Outlook 性能的影响。但是，根据客户端计算机上的设置，新邮件到达收件箱后，垃圾邮件过滤和将新邮件从收件箱移动到另一个文件夹的客户端规则等过程可能会异步发生。

Dim mail as Object

Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
    Set mail =  Application.GetNamespace("MAPI").GetItemFromID(EntryIDCollection)
End Sub

另一种可能的方法是连接到收件箱文件夹的ItemAdd 事件：

Private WithEvents Items As Outlook.Items
Private Sub Application_Startup()
    Dim olNs As Outlook.NameSpace
    Dim Inbox  As Outlook.MAPIFolder

    Set olNs = Application.GetNamespace("MAPI")
    Set Inbox = olNs.GetDefaultFolder(olFolderInbox)
    Set Items = Inbox.Items
End Sub

Private Sub Items_ItemAdd(ByVal Item As Object)
    If TypeOf Item Is Outlook.MailItem Then
        Example Item ' call sub
    End If
End Sub

Public Sub Example(ByVal Item As Object)
    Debug.Print Item.Subject 
End Sub