从 Outlook 保存多个附件

Question

我正在尝试将附件保存在数百封电子邮件中。 我发现 VBA 宏与我正在寻找的内容很接近，链接如下。 问题是每封电子邮件中的附件名称相同，当宏运行并循环附件时，它会覆盖以前保存的附件。 有什么建议吗？

使用静态名称保存并重命名 Outlook 附件

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

    Counter = 1
    sSaveFolder = "C:\Invoices\"
    For Each oAttachment In MItem.Attachments
        oAttachment.SaveAsFile sSaveFolder & "Statments(s)" & Counter & ".pdf"
        Counter = Counter + 1
    Set oAttachment = Nothing
    Next
End Sub

我也尝试了这个宏，得到了基本相同的结果。 Outlook 使用主题行保存多个附件，并递增该名称

Answer 1

为了防止覆盖同名的附件，在文件名中添加计数器的方法是一个好的开始。但是，如果宏处理多封电子邮件但为每封电子邮件重置计数器，则可能会出现问题。为了确保多封电子邮件中的文件名唯一，您可以在文件名中包含时间戳或电子邮件主题，以获得更好的唯一性。

另一种方法是计算目标目录中的文件数量，并在保存附件时将其用作唯一标识符。

您可以使用类似下面的代码（未经测试，因为我不使用 Outlook，但这个想法应该没问题）：

Public Sub SaveAttachmentsToDisk(MItem As Outlook.MailItem)
    Dim oAttachment As Outlook.Attachment
    Dim sSaveFolder As String
    Dim Counter As Integer
    Dim sDate As String
    Dim sSubject As String
    Dim sFileName As String
    
    Counter = 1
    sSaveFolder = "C:\Invoices\"
    
    ' Format the email received date as a string to append to the file name
    sDate = Format(MItem.ReceivedTime, "yyyymmdd_hhmmss")
    ' Clean up the subject to use it in the file name
    sSubject = Replace(MItem.Subject, " ", "_")
    sSubject = Replace(sSubject, ":", "")
    
    For Each oAttachment In MItem.Attachments
        ' Create a unique file name by appending the date and counter
        sFileName = sSaveFolder & "Statement_" & sDate & "_" & Counter & ".pdf"
        
        ' Save the attachment
        oAttachment.SaveAsFile sFileName
        Counter = Counter + 1
    Next
End Sub