根据电子邮件主题保存电子邮件附件

Question

每天上午 12 点，都会自动收到一封来自供应商服务的带有特定主题的 Excel 附件的电子邮件。我正在使用规则和代码来尝试保存附件并将信息插入到我在收件箱中收到时创建的数据库中。

我尝试了我在网上找到的代码，但我不知道是否因为我公司的某些网络/安全设置而无法正常工作，或者是他自己编写的代码。

规则：

代码：

Public Sub CribMaster2Database(itm As Outlook.MailItem)
Dim objAtt As Outlook.Attachment
Dim saveFolder As String

saveFolder = "c:\temp\"
    If olItem.Subject = "Test" Then
        For Each objAtt In itm.Attachments
            objAtt.SaveAsFile saveFolder & "\" & objAtt.DisplayName
            Set objAtt = Nothing
        Next
    End If

End Sub

Answer 1

将代码添加到 ThisOutlookSession 以监视您的文件夹是否到达。
CribMaster_ItemAdd 会在您监视的文件夹中到达时触发。

在模块的最顶部：

Dim WithEvents CribMaster As Items

Const SAVE_PATH As String = "c:\temp\"

Private Sub Application_Startup()

    Dim ns As Outlook.NameSpace
    Set ns = GetNamespace("MAPI")

    'Change `holi4683` to the name of your account
    '(should be visible just above your inbox).
    Set CribMaster = ns.Folders.Item("holi4683") _
            .Folders.Item("Inbox").Items

End Sub

Sub CribMaster_ItemAdd(ByVal Item As Object)
    Dim olAtt As Attachment
    Dim i As Integer

    With Item
        For i = 1 To .Attachments.Count
            Set olAtt = .Attachments(i)
            olAtt.SaveAsFile SAVE_PATH & olAtt.DisplayName
            .UnRead = False
            DoEvents
        Next i
    End With
    Set olAtt = Nothing

End Sub  

我通常会使用规则将电子邮件移动到子文件夹并观看该文件夹 - 这意味着我不必担心会议邀请等。
为此，您需要像这样更改您的监视文件夹：

Set CribMaster = ns.Folders.Item("holi4683") _
        .Folders.Item("Inbox") _
        .Folders.Item("SubFolder").Items  

重新启动 Outlook 以使代码正常工作，或手动运行 Application_Startup() 过程。