I am trying to create a macro that can save my email attachments with a link to the attachment in the original email. I would also like the attachments have the date received in the file name, and if there are two files received on the same day then any duplicates could have a (2) at the end of the file name (or 3, 4, etc.).

Below is the code I am trying to work with

Sub SaveAllAttachments()
    Const msoFileDialogFolderPicker = 4
    Dim olkMsg As Object, intIdx As Integer, excApp As Object, strPath As String, strBuffer As String
    Set excApp = CreateObject("Excel.Application")
    With excApp.FileDialog(msoFileDialogFolderPicker)
        .Show
        For intIdx = 1 To .SelectedItems.count
            strPath = .SelectedItems(intIdx)
        Next
    End With
    If strPath <> "" Then
        For Each olkMsg In Application.ActiveExplorer.Selection
            For intIdx = olkMsg.Attachments.count To 1 Step -1
                If Not IsHiddenAttachment(olkMsg.Attachments.Item(intIdx)) Then
                    olkMsg.Attachments.Item(intIdx).SaveAsFile strPath & "\" & olkMsg.Attachments.Item(intIdx).FILENAME
                    strBuffer = strBuffer & "<a href=""" & strPath & "\" & olkMsg.Attachments.Item(intIdx).FILENAME & """>" & olkMsg.Attachments.Item(intIdx).FILENAME & "</a>" & vbCrLf
                End If
            Next
            Select Case olkMsg.BodyFormat
                Case olFormatHTML
                    If Len(strBuffer) > 0 Then
                        strBuffer = Left(strBuffer, Len(strBuffer) - 1)
                        strBuffer = Replace(strBuffer, vbCrLf, "<br>")
                        olkMsg.HTMLBody = olkMsg.HTMLBody & "<p>Saved Attachments & <br><br>" & strBuffer & "</p>"
                    End If
                Case Else
                    If Len(strBuffer) > 0 Then
                        strBuffer = Left(strBuffer, Len(strBuffer) - 1)
                        olkMsg.Body = olkMsg.Body & vbCrLf & vbCrLf & "Saved Attachments" & vbCrLf & vbCrLf & strBuffer
                    End If
            End Select
            olkMsg.Close olSave
            Set olkMsg = Nothing
        Next
    End If
    Set excApp = Nothing
End Sub
  
Private Function IsHiddenAttachment(olkAttachment As Outlook.Attachment) As Boolean
    'Purpose: Determines if an attachment is embedded.'
    'Written: 10/12/2010'
    'Outlook: 2007'
    Dim olkPA As Outlook.PropertyAccessor
    On Error Resume Next
    Set olkPA = olkAttachment.PropertyAccessor
    IsHiddenAttachment = olkPA.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x7ffe000b")
    On Error GoTo 0
    Set olkPA = Nothing
End Function
Thank you for your time.