Outlook VBA 使用接收时间和发件人姓名保存电子邮件附件

Question

问题：从电子邮件中保存多个具有相同文件名的附件只会将一个附件保存到文件夹

可能的解决方案：将收到的时间和发件人的姓名添加到新文件名 我有一些 VBA 代码，我在 Internet 上找到了这些代码，我一直在使用这些代码并且效果很好。 如果已经有人问过这个问题，我很抱歉，但我已经研究了几个星期，似乎有多种方法可以做到这一点，但并非所有方法都适用于我的代码。 如果可能，我不想运行规则脚本。

我使用下面的 VBA 代码在 Outlook 365 中使用。代码的工作原理是它将电子邮件附件保存到我在 Outlook 中选择的电子邮件上的特定文件夹中。 我遇到的问题是宏无法获取同名附件。 例如，我将有多个名为“image.pdf”的附件，但它只保存一个具有该名称和文件类型的附件。 我在考虑是否可以将接收日期和时间以及发件人姓名添加到文件名中，这将有助于使文件名唯一并保存所有附件。 但是，当我使用代码尝试此操作时，我认为会起作用，但会出现错误。 下面是我正在使用的代码。 它涉及两个宏。 名为“Save_Emails_TEST”的宏找到我指定的文件夹，然后调用实际保存附件的“SaveAttachments”宏。

请求：有人可以帮我添加接收日期和时间、发件人姓名和原始文件名作为保存在我文件夹中的新文件名吗？

先感谢您！

瑞安

Public Sub Save_Emails_TEST()
strFolderpath = "H:\Saved Email Attachments\Test\"
SaveAttachments
End Sub

Private Sub SaveAttachments()
Dim objOL As Outlook.Application
Dim objMsg As Object
Dim objAttachments As Outlook.Attachments
Dim objSelection As Outlook.Selection
Dim i As Long
Dim lngCount As Long
Dim strFile As String

    On Error Resume Next
    Set objOL = Application

    Set objSelection = objOL.ActiveExplorer.Selection

    ' Check each selected item for attachments.
    For Each objMsg In objSelection

    Set objAttachments = objMsg.Attachments
    lngCount = objAttachments.count
        
    If lngCount > 0 Then
    
    ' Use a count down loop for removing items
    ' from a collection. Otherwise, the loop counter gets
    ' confused and only every other item is removed.
    
    For i = lngCount To 1 Step -1
    
    ' Get the file name.
    strFile = objAttachments.Item(i).FileName
    
    ' Combine with the path to the folder.
    strFile = strFolderpath & strFile
    
    ' Save the attachment as a file.
    objAttachments.Item(i).SaveAsFile strFile
    
    Next i
    End If
    
    Next
    
ExitSub:

Set objAttachments = Nothing
Set objMsg = Nothing
Set objSelection = Nothing
Set objOL = Nothing
End Sub

Answer 1

Dim date_now As Date
Dim dateStamp As String
Dim LRandomNumber As Integer

For i = lngCount To 1 Step -1
    
    ' Get the file name.
    strFile = objAttachments.Item(i).FileName
    
    LRandomNumber = Int((300 - 200 + 1) * Rnd + 200)
    date_obj =  objMsg.ReceivedTime ' Now()
    dateStamp = Format(date_obj, "yyyy-mm-dd-hh-mm-ss")

     ' Combine with the path to the folder.
    strFile = strFolderpath & dateStamp & LRandomNumber & strFile

    ' Save the attachment as a file.
    objAttachments.Item(i).SaveAsFile strFile

Next i