如何从 Outlook 自动保存附件？

Question

我正在尝试将具有特定主题行的电子邮件中的所有附件自动保存到文件夹中。我已经尝试从 SO 和其他来源的其他问题中实施多种解决方案，但它们不起作用。 我通常会尝试遵循此处概述的流程：https://windowsreport.com/outlook-rule-download-attachments/

我在 VBA 编辑器中有以下脚本。

Public Sub SaveAttachmentsToDisk(MItem As Outlook.MailItem)
Dim oAttachment As Outlook.Attachment
Dim sSaveFolder As String

sSaveFolder = "H:\temp\_nre_POs\"
For Each oAttachment In MItem.Attachments
oAttachment.SaveAsFile sSaveFolder & oAttachment.DisplayName
Set oAttachment = Nothing
Next
End Sub

我还创建了以下规则来处理主题行。将电子邮件移动到 _Invoices 文件夹的规则已经到位并且工作了几个月，我只是添加了“运行脚本”选项。在收件箱中的现有电子邮件上运行规则时，我没有收到任何错误，但我也没有在目标文件夹中显示任何附件。理想情况下，这应该在后台运行，但我对更手动的过程持开放态度。 Pic of outlook rule

编辑：我最终使用下面的脚本让它工作。它可能有点乱，但它有效。

Public Sub Application_Startup()

Dim MItem As MailItem
Dim oAttachment As Attachment
Dim sSaveFolder As String
Dim oDefInbox As Folder
Dim targetFolder As Folder
Dim myItems As Outlook.Items
Dim Item As Object

Set oDefInbox = Session.GetDefaultFolder(olFolderInbox)
Set targetFolder = Session.GetDefaultFolder(olFolderInbox).Parent.Folders("_Invoices")

sSaveFolder = "H:\temp\_nre_POs"
For Each MItem In targetFolder.Items
    If MItem.UnRead = True Then
        For Each oAttachment In MItem.Attachments
            oAttachment.SaveAsFile sSaveFolder & oAttachment.DisplayName
            Set oAttachment = Nothing
        Next oAttachment
        MItem.UnRead = False
    End If
Next MItem

End Sub

Answer 1

您可以在 ThisOutlookSession 模块中使用事件 Application_NewMail，即"occurs when one or more new email messages are received in the Inbox"：

Private Sub Application_NewMail()
    Set myOlApp = GetObject(, "Outlook.Application")
    Set myNamespace = myOlApp.GetNamespace("MAPI")
    Set myFolder = myNamespace.GetDefaultFolder(olFolderInbox)
    Set myItem = myFolder.Items(1)
    SaveAttachmentsToDisk myItem
End Sub

Answer 2

在这种情况下，规则是错误的。从规则中删除移动。将移动动作放入代码中。

Option Explicit

Public Sub SaveAttachmentsToDisk(MItem As MailItem)

Dim oAttachment As Attachment
Dim sSaveFolder As String
Dim oDefInbox As folder
Dim targetFolder As folder

sSaveFolder = "H:\temp\_nre_POs\"
For Each oAttachment In MItem.Attachments
    oAttachment.SaveAsFile sSaveFolder & oAttachment.DisplayName
    Set oAttachment = Nothing
Next

Set oDefInbox = Session.GetDefaultFolder(olFolderInbox)

' where the Invoices folder is directly below the Inbox
Set targetFolder = oDefInbox.folders("Invoices")

' If Invoices is nested deeper - https://stackoverflow.com/a/48916736/1571407
'  in https://stackoverflow.com/questions/8322432/using-visual-basic-to-access-subfolder-in-inbox

MItem.Move targetFolder

End Sub