根据标题自动保存outlook附件

Question

我想建立一个单驱动器文件夹，为我们公司的各种客户保存报告。我们的报告软件只发送到电子邮件，而不是保存到文件，所以我在谷歌上搜索并找到了这段代码，可以自动将所有附件下载到文件夹

Public Sub saveAttachtoDisk(itm As Outlook.MailItem)
Dim objAtt As Outlook.Attachment
Dim saveFolder As String
Dim dateFormat
    dateFormat = Format(Now, "yyyy-mm-dd H-mm")
saveFolder = "C:Report Attachments"
     For Each objAtt In itm.Attachments
         objAtt.SaveAsFile saveFolder & "" & dateFormat & objAtt.DisplayName
          Set objAtt = Nothing
     Next
End Sub

问题是我想按公司划分报告。例如，我希望A公司的报告转到

C： \报告附件\公司A

并向报告B公司

C： \报告附件\公司B

等等。每个报表都应该在附件的标题中有公司名称，所以我正在寻找对代码的调整，以根据附件标题更改保存位置。这可能吗？

Answer 1

设置一个规则，在电子邮件到达时将其移动到特定文件夹（可能是基于电子邮件地址域的规则）。

在Outlook的ThisOutlookSession模块中，在声明部分输入以下代码：

Dim WithEvents CompanyA As Items
Dim WithEvents CompanyB As Items
Const COMPA_PATH As String = "C:Report AttachmentsCompany A"
Const COMPB_PATH As String = "C:Report AttachmentsCompany B"
Private Sub Application_Startup()
    Dim ns As Outlook.NameSpace
    Set ns = Application.GetNamespace("MAPI")
    Set CompanyA = ns.Folders.item("Mailbox - tomdemaine") _
                        .Folders.item("Inbox") _
                        .Folders.item("CompanyA").Items
    Set CompanyB = ns.Folders.item("Mailbox - tomdemaine") _
                        .Folders.item("Inbox") _
                        .Folders.item("CompanyA").Items
End Sub
Sub CompanyA_ItemAdd(ByVal item As Object)
    Dim oAtt As Attachment
    If item.Attachments.Count > 0 Then
        For Each oAtt In item.Attachments
            item.UnRead = False
            'Note DisplayName may contain illegal characters.
            oAtt.SaveAsFile COMPA_PATH & oAtt.DisplayName
            DoEvents
        Next oAtt
    End If
    Set oAtt = Nothing
End Sub
Sub CompanyB_ItemAdd(ByVal item As Object)
    Dim oAtt As Attachment
    If item.Attachments.Count > 0 Then
        For Each oAtt In item.Attachments
            item.UnRead = False
            'Note DisplayName may contain illegal characters.
            oAtt.SaveAsFile COMPB_PATH & oAtt.DisplayName
            DoEvents
        Next oAtt
    End If
    Set oAtt = Nothing
End Sub

代码将开始监视您的公司A&启动Outlook时使用CompanyB文件夹。任何时候，只要有包含附件的东西被移动到那里，它就会将它们保存到您的文件位置，并将电子邮件标记为已读。

我还没有测试代码，Outlook文件夹和文件位置需要更新以满足您的需求。