Save attachments in order

Question

I am trying to run a macro via rule in Outlook that saves attachments into a folder.

Emails sometimes have more than one attachment. I am trying to save the files in order, so for example if I go to down the emails I can easily see the file that corresponds to it.

I have the following that I found online:

Public Sub saveAttachtoDisk(itm As Outlook.MailItem)

    Dim objAtt As Outlook.Attachment
    Dim saveFolder As String
    saveFolder = "C:\PathToDirectory\"

    Dim dateFormat As String
    dateFormat = Format(itm.ReceivedTime, "yyyy-mm-dd Hmm ")

    For Each objAtt In itm.Attachments
        objAtt.SaveAsFile saveFolder & "\" & dateFormat & objAtt.DisplayName
    Next

End Sub

I've tried to play with objatt.displayname with no luck. I've tried assigning new names and creating a new loop that names the files File 1 , File 2 and so on but when I do that I lose the file extension.

Updated Version:

Option Explicit

Public Sub save_attachments(itm As Outlook.MailItem)

Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Dim strExt As String
Dim i As Long
Dim savefolder As String

i = 1

savefolder = "C:\Users\w\desktop\test"

For Each objAtt In itm.Attachments
    i = i + 1
    strExt = fso.GetExtensionName(objAtt.DisplayName)
    objAtt.SaveAsFile savefolder & "\" & dateFormat & " - File " & i & "." & strExt
Next

End Sub   

Answer 1

You could do something like this in your existing subroutine. This would increment a "File" number and still preserve the extension.

Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Dim strExt As String
Dim i As Long

For Each objAtt In itm.Attachments
    i = i + 1
    strExt = fso.GetExtensionName(objAtt.DisplayName)
    objAtt.SaveAsFile saveFolder & "\" & dateFormat & " - File " & i & "." & strExt
Next