Переименование / перемещение вложений с использованием VB - Filenameincrement

Этот сценарий может показаться знакомым, потому что я взял эту копию из Superuser (или Stackoverflow) и изменил ее в соответствии со своими потребностями. Сценарий перемещает элементы Outlook, копирует вложение в папку и затем печатает все вложения. Это чрезвычайно полезно, так как мои пользователи обычно печатают сотни вложений каждый день, это значительно экономит время.

У меня проблема с Filenameincrementer. Он продолжает переименовывать мои файлы следующим образом:

Файл.pdf1 Файл.pdf2 Файл.pdf3 Файл.pdf4

Пока хочу:

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

Что я могу сделать, чтобы достичь этого?

Отказ от ответственности: Первый раз балуюсь VB, так что будьте нежны.

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

Вы можете сделать это с помощью хака, если этого достаточно. Поскольку .pdfон уникален, мы можем просто найти его, удалить, а затем добавить в конце.

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

Я не могу это проверить, но это должно работать нормально ...