Renomeando / movendo anexos usando o VB - Filenameincrement

Esse script pode parecer familiar porque peguei essa cópia do Superusuário (ou Stackoverflow) e a alterei para atender às minhas necessidades. O script move os itens do Outlook, copia o anexo para uma pasta e, em seguida, imprime todos os anexos. É extremamente útil, pois meus usuários geralmente imprimem centenas de anexos por dia, é uma grande economia de tempo.

Um problema que estou tendo é com o Filenameincrementer. Ele continua renomeando meus arquivos da seguinte maneira:

File.pdf1 Arquivo.pdf2 File.pdf3 File.pdf4

Enquanto eu quero:

File1.pdf Arquivo2.pdf File3.pdf File4.pdf

O que posso fazer para conseguir isso?

Disclaimer: Primeira vez brincando com VB, então seja gentil.

Public Sub PrintPDFs()
Dim Inbox As MAPIFolder
Dim Item As MailItem
Dim Atmt As Attachment
Dim FileName As String
Dim i As Integer
Dim Filenameincrementer As Integer
Filenameincrementer = 1

Set Inbox = GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Parent.Folders.Item("MAIL_INCOMING")

For Each Item In Inbox.Items
For Each Atmt In Item.Attachments
FileName = "X:\Folder\" & Atmt.FileName & Filenameincrementer
Atmt.SaveAsFile FileName
Shell """C:\Program Files\Foxit Software\Foxit Reader\Foxit Reader.exe"" -p """ + FileName + """", vbHide
Filenameincrementer = Filenameincrementer + 1
Next
Item.Move GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Parent.Folders.Item("MAIL_PRINTED")
Next

Set Inbox = Nothing
End Sub

Você pode fazer isso com um hack, se for suficiente. Desde a .pdf é bastante único, podemos apenas procurá-lo, removê-lo e adicioná-lo no final.

FileName = "X:\Folder\" & Atmt.FileName & Filenameincrementer 'remains the same
FileName = Replace(FileName, ".pdf", "") & ".pdf" ' I'm a new line of code. Hurray
Atmt.SaveAsFile FileName 'remains the same

Eu não posso testar isso, mas deve funcionar bem ...