Save Email Attachments with Received Time and Sender Name

[AlbinoRyno88]

Hi Everyone,

Goal: My goal is to have a macro that saves all emails attachments to a specific folder on emails that I have selected in my Outlook.

What I have tried: I have code, see below, that works great but....when I have multiple attachments with the same file name the macro only saves one of the attachments. For example, I will have multiple attachments called "image.pdf" but it only saves one attachment with that name and file type. I have been researching this for weeks and have tried a few different methods but none have worked for my needs or worked at all.

Microsoft Version: Outlook 365

How my code works: How my code works is it saves email attachments to a specific folder on emails that I have selected in Outlook. It involves two macros. The macro called "Save_Emails_TEST" finds the folder I have designated and then calls on the "SaveAttachments" macro that actually saves the attachments.

My request is this. Can someone please help me add code to my existing code. I would like this code to add the received date and time, senders' name, and original file name as the new file name for the files that are saved in my external folder.

Thank you in advance!
Ryan

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