Vba 批量打印来自多封电子邮件的同名附件

我在Outlook 2013中有电子邮件，每封都只附带一个名为“Report.pdf”的文件

我正在尝试批量打印所选电子邮件中的所有附件

我找到了下面的代码，如果附件都有不同的名称，它就可以工作。有没有可能修改这一点，以打印近150个附件，所有这些附件都有相同的名称

报告的名称无关紧要，因此可以在代码中随意添加所需内容

Sub BatchPrintAllAttachmentsinMultipleEmails()
Dim objFileSystem As Object
Dim strTempFolder As String
Dim objSelection As Outlook.Selection
Dim objItem As Object
Dim objMail As Outlook.MailItem
Dim objAttachments As Outlook.Attachments
Dim objAttachment As Outlook.Attachment
Dim objShell As Object
Dim objTempFolder As Object
Dim objTempFolderItem As Object
Dim strFilePath As String
Dim DateFormat

Set objFileSystem = CreateObject("Scripting.FileSystemObject")
strTempFolder = objFileSystem.GetSpecialFolder(2).Path & "\Temp for Attachments " & Format(Now, "YYYY-MM-DD_hh-mm-ss")
'Create a new temp folder
MkDir (strTempFolder)

Set objSelection = Outlook.Application.ActiveExplorer.Selection

For Each objItem In objSelection
    If TypeOf objItem Is MailItem Then
       Set objMail = objItem
       Set objAttachments = objMail.Attachments

       'Save all the attachments in the temp folder
       For Each objAttachment In objAttachments
           strFilePath = strTempFolder & "\" & objAttachment.FileName
           objAttachment.SaveAsFile (strFilePath)

           'Print all the files in the temp folder
           Set objShell = CreateObject("Shell.Application")
           Set objTempFolder = objShell.NameSpace(0)
           Set objTempFolderItem = objTempFolder.ParseName(strFilePath)
           objTempFolderItem.InvokeVerbEx ("print")
       Next objAttachment
    End If
Next
End Sub

---

如果所有附件都具有相同的名称，则不会说明代码不起作用的原因。我认为这是因为

SaveAsFile

希望在打印完成之前用下一个“Report.pdf”覆盖上一个“Report.pdf”

我的第一个想法是在

SaveAsFile

之前添加

Kill strFilePath

。经过深思熟虑，我决定这样做行不通，因为当您试图删除之前的“Report.pdf”时，Shell仍将打印它

我认为最简单的方法是：

加

给你的影子

将strFilePath=strTempFolder&“\”&objAttachment.FileName替换为：

Count = Count + 1
strFilePath = strTempFolder & "\" & Count & objAttachment.FileName

这将创建并打印名为“1Report.pdf”、“2Report.pdf”、“3Report.pdf”等文件。我使用了前缀而不是传统的后缀，因为它省去了在文件名和扩展名之间放置

Count

的麻烦

我假设您有某种方法可以从临时文件夹中删除所有附件

Count = Count + 1
strFilePath = strTempFolder & "\" & Count & objAttachment.FileName