如何通过VBA为Thunderbird邮件添加自动生成的PDF附件？

问题说明 #

已通过VBA代码打开Thunderbird并填写邮件主题、正文等字段，需实现将同一代码生成的PDF文件作为附件添加到邮件中。

修改后的完整代码 #

Sub ToPDFandSend()

    Dim filesave As FileDialog
    Dim rng As Range
    Dim PDFfileName As String
    Dim formatIndex As Long, i As Long
    Dim PDFpath As String '新增：存储PDF的完整保存路径
    
    '邮件相关变量
    Dim thund As String
    Dim email As String
    Dim subj As String
    Dim body As String
    Dim t As Integer, f As Integer '声明原代码缺失的变量
       
    Set filesave = Application.FileDialog(msoFileDialogSaveAs)
    
    Select Case Sheets("Factura").Range("M1").Value
        Case 1: t = 1: f = 1 '导出第1页
        Case Else: f = 1: t = 2 '导出第1-2页
    End Select
    
    With ThisWorkbook.Worksheets("Factura")
        Set rng = .Range("A1:J97")
        Data = Format(.Range("A13"), "YYYYMMDD") '修正：明确引用当前工作表单元格
        PDFfileName = .Range("H1").Value & " " & .Range("A17").Value & " " & Data '修正：明确引用当前工作表单元格
    End With
    
    With filesave
        .Title = "Save as PDF"
        .InitialFileName = PDFfileName
        formatIndex = 0
        For i = 1 To .Filters.Count
            If InStr(1, .Filters(i).Extensions, "pdf", vbTextCompare) > 0 Then formatIndex = i
        Next
        If formatIndex > 0 Then .FilterIndex = formatIndex
        
        '仅当用户确认保存PDF后，才执行后续邮件生成逻辑
        If .Show Then
            PDFpath = .SelectedItems(1) '记录PDF的完整路径
            rng.ExportAsFixedFormat _
                Type:=xlTypePDF, _
                Filename:=PDFpath, _
                OpenAfterPublish:=False, _
                IncludeDocProperties:=True, _
                IgnorePrintAreas:=True, _
                from:=f, _
                to:=t, _
                Quality:=xlQualityStandard
                
            '生成邮件
            With ThisWorkbook.Worksheets("Factura")
                Data = Format(.Range("A13"), "YYYY/MM/DD") '修正：明确引用当前工作表单元格
                Mes = MonthName(Month(Data))
                body = "Benvolguts," & vbNewLine & "Us faig arribar la factura corresponent al mes de " & Mes & "." & vbNewLine & "Atentament,"
                email = ""
                subj = "Factura Nº" & " " & .Range("H1").Value
                
                '在Thunderbird命令行中添加附件参数
                thund = "C:\Program Files\Mozilla Thunderbird\thunderbird.exe" & _
                        " -compose " & """" & _
                        "to='" & email & "'," & _
                        "subject='" & subj & "'," & _
                        "body='" & body & "'," & _
                        "attachment='" & PDFpath & "'" & """"
        
                Call Shell(thund, vbNormalFocus)
            End With
        End If
    End With
End Sub

关键修改点 #

• 新增PDFpath变量：存储用户选择的PDF完整保存路径，确保后续能准确找到附件文件
• 修正工作表引用：给原代码中部分未指定工作表的Range添加前缀，避免引用错误
• 调整执行逻辑：将邮件生成代码移到PDF保存确认分支内，避免用户取消保存后仍触发邮件
• 添加附件参数：在Thunderbird的-compose命令中加入attachment字段，指定要添加的PDF路径

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