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:
Arquivo.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. Como .pdf é bastante exclusivo, podemos procurar, remover e adicionar 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 ...