VBA代码优化需求：无需保存PDF即可通过Outlook发送Excel文件

我来帮你搞定这个问题！你遇到的情况是VBA里很常见的错误处理场景——当用户取消PDF保存对话框时，原代码因为没捕获这个操作直接抛出错误，中断了后续的邮件发送流程。咱们可以通过捕获取消操作+临时文件兜底的方式优化，既能让用户选择是否保存本地PDF副本，又能在取消保存时依然正常触发邮件。

优化后的完整代码 #

Option Explicit
Public tempPdfPath As String ' 模块级变量，供删除临时文件的子程序使用

Sub ExcelToPDFAndEmail()
    Dim pdfPath As String
    Dim outlookApp As Object
    Dim outlookMail As Object
    Dim targetSheet As Worksheet
    Dim userCanceledSave As Boolean
    
    ' 设定要导出的工作表（可改成你需要的，比如指定工作表名：ThisWorkbook.Worksheets("Sheet1")）
    Set targetSheet = ActiveSheet
    
    ' 生成系统临时文件夹的PDF路径，避免占用用户指定的保存路径
    tempPdfPath = Environ("TEMP") & "\" & Replace(targetSheet.Name, " ", "_") & "_Temp_" & Format(Now(), "YYYYMMDDHHMMSS") & ".pdf"
    
    ' 弹出保存对话框，让用户选择是否保存本地PDF
    On Error Resume Next
    pdfPath = Application.GetSaveAsFilename( _
        FileFilter:="PDF Files (*.pdf), *.pdf", _
        Title:="选择PDF保存位置（取消则仅生成邮件附件）")
    userCanceledSave = (pdfPath = "False")
    On Error GoTo 0
    
    ' 先导出一份PDF到临时文件夹——不管用户要不要存本地，都用这个临时文件发邮件
    targetSheet.ExportAsFixedFormat _
        Type:=xlTypePDF, _
        Filename:=tempPdfPath, _
        Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, _
        OpenAfterPublish:=False
    
    ' 如果用户没取消保存，就再导出一份到用户指定的路径
    If Not userCanceledSave Then
        targetSheet.ExportAsFixedFormat _
            Type:=xlTypePDF, _
            Filename:=pdfPath, _
            Quality:=xlQualityStandard, _
            IncludeDocProperties:=True, _
            IgnorePrintAreas:=False, _
            OpenAfterPublish:=False
        MsgBox "PDF已保存到指定位置！", vbInformation
    End If
    
    ' 启动Outlook并创建邮件
    On Error Resume Next
    Set outlookApp = GetObject(, "Outlook.Application")
    ' 如果Outlook没打开，就新建一个实例
    If Err.Number <> 0 Then
        Set outlookApp = CreateObject("Outlook.Application")
    End If
    On Error GoTo 0
    
    Set outlookMail = outlookApp.CreateItem(0) ' 0代表创建普通邮件
    
    ' 配置邮件内容（可根据需求修改）
    With outlookMail
        .To = "" ' 可预设收件人邮箱
        .CC = ""
        .BCC = ""
        .Subject = "【Excel导出】" & targetSheet.Name & "的PDF文件"
        .Body = "您好，附件是从Excel导出的PDF文件，请查收。"
        .Attachments.Add tempPdfPath ' 添加临时PDF作为附件
        .Display ' 弹出邮件窗口让用户编辑发送
    End With
    
    ' 10秒后自动删除临时PDF（避免邮件窗口占用文件导致删除失败）
    Application.OnTime Now() + TimeValue("00:00:10"), "DeleteTempPdf"
    
    ' 释放对象，避免内存泄漏
    Set outlookMail = Nothing
    Set outlookApp = Nothing
    Set targetSheet = Nothing
    
    MsgBox "邮件已准备就绪！", vbInformation
End Sub

' 辅助子程序：删除临时PDF文件
Sub DeleteTempPdf()
    On Error Resume Next
    Kill tempPdfPath
    On Error GoTo 0
End Sub

核心优化说明 #

• 捕获取消操作：用Application.GetSaveAsFilename替代直接在ExportAsFixedFormat里弹出对话框，这样能判断用户是否点击了取消，不会触发运行时错误。
• 临时文件兜底：不管用户要不要保存本地PDF，先导出一份到系统临时文件夹，用这个文件作为邮件附件——这样即使用户取消保存，邮件依然能正常生成。
• 可选本地保存：如果用户确认保存，再导出一份到用户指定的路径，兼顾保存本地副本的需求。
• 错误防护：对Outlook启动、临时文件删除等环节添加错误捕获，避免意外中断。

注意事项 #

1. 一定要把tempPdfPath声明为模块级变量（在模块顶部写Public tempPdfPath As String），否则DeleteTempPdf子程序找不到这个路径。
2. 10秒延迟删除是为了防止邮件窗口还在占用临时文件，如果你觉得时间太长，可以调整TimeValue("00:00:10")的数值，比如改成5秒。
3. 如果需要导出整个工作簿而不是单个工作表，把Set targetSheet = ActiveSheet改成Set targetSheet = ThisWorkbook，其他代码不用改。

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