Renaming/moving attachments using VB - Filenameincrement

Question

This script may seem familiar because I took this copy from Superuser (or Stackoverflow) and changed it to suit my needs. The script moves Outlook items around, copies the attachment to a folder and then prints all of the attachments. It's extremely useful as my users generally print hundreds of attachments each day, it's a huge timesaver.

One issue I am having is with Filenameincrementer. It keeps renaming my files the following way:

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

While I want:

File1.pdf File2.pdf File3.pdf File4.pdf

What can I do to achieve this?

Disclaimer: First time dabbling with VB, so be gentle.

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

Answer 1

You can do this with a hack if it suffices. Since .pdf is quite unique, we can just search for it, remove it, and then add it on the end.

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

I can't test that but it should work fine...