修改VBA代码实现动态添加同子程序生成的PDF邮件附件

核心思路是在生成PDF时记录每个文件的完整路径，之后遍历这些路径逐个添加为附件，避免静态引用文件名。

修改后的完整代码 #

Sub PrintToPDF()
    Dim ws As Worksheet
    Dim strPath As String
    Dim strFile As String
    Dim OlApp As Object
    Dim OlMail As Object
    Dim ToRecipient As Variant
    Dim CcRecipient As Variant
    Dim BccRecipient As Variant
    Dim pdfFiles As New Collection ' 新增：存储所有生成的PDF路径
    
    ' 指定PDF保存文件夹
    strPath = "C:\Users\..."
    
    ' 遍历选中工作表并导出为PDF，同时记录文件路径
    For Each ws In ActiveWindow.SelectedSheets
        strFile = strPath & Format(Range("G9").Text, "YYYY-MM") & " XXXX0000 " & ws.Name & ".pdf"
        ws.ExportAsFixedFormat Type:=xlTypePDF, Filename:=strFile, Quality:=xlQualityStandard
        pdfFiles.Add strFile ' 将生成的PDF路径加入集合
    Next ws

    ' 创建邮件
    Set OlApp = CreateObject("Outlook.Application")
    Set OlMail = OlApp.CreateItem(olMailItem)

    ' 添加收件人
    For Each ToRecipient In Array("user@domain.com")
        OlMail.Recipients.Add ToRecipient
    Next ToRecipient
    
    For Each CcRecipient In Array("user@domain.com", "user@domain.com", "user@domain.com")
        OlMail.Recipients.Add CcRecipient
    Next CcRecipient
    
    For Each BccRecipient In Array("user@domain.com")
        OlMail.Recipients.Add BccRecipient
    Next BccRecipient
    
    ' 填写邮件主题
    OlMail.Subject = "00-XXXX000 Billing"

    ' 动态添加所有生成的PDF作为附件
    Dim pdfPath As Variant
    For Each pdfPath In pdfFiles
        OlMail.Attachments.Add pdfPath
    Next pdfPath
    
    OlMail.Display
    ' OlMail.Send
End Sub

关键修改说明 #

• 新增pdfFiles集合对象，用于存储每一个生成的PDF文件完整路径，解决文件名动态变化无法静态引用的问题。
• 在导出PDF的循环中，每次生成strFile后，立即将其添加到pdfFiles集合中。
• 在添加附件的部分，遍历pdfFiles集合，逐个将PDF文件添加为邮件附件，确保所有生成的PDF都被包含。

内容的提问来源于stack exchange，提问作者brandyfur