Excel邮件合并VBA宏执行异常：无PDF/Word输出问题排查

核心问题分析 #

你的代码执行后无PDF生成，主要由以下几个关键错误导致：

1. 路径拼接错误
   SavePath末尾缺少路径分隔符\，导致保存时路径拼接为无效格式（如C:\Users\username\Documents\Notice FolderName of Document xxx.pdf），系统无法识别并创建文件。

2. 嵌套With块的单元格引用错误
   在With wdDoc.Content.Find代码块内，.Cells(i, 1)会被解析为Word对象的Cells属性，而非Excel工作表的单元格，导致无法读取正确的数据源进行标记替换。

3. Find匹配参数不明确
   未显式设置MatchCase、MatchWholeWord等参数，可能导致模板中的标记无法被准确匹配和替换。

修正后的完整代码 #

Sub MailMergeToPDF()
    Dim wdApp As Object ' Word.Application
    Dim wdDoc As Object ' Word.Document
    Dim SourcePath As String
    Dim SavePath As String
    Dim i As Long
    Dim ws As Worksheet ' 定义工作表对象，避免引用混淆
    
    ' 绑定数据源工作表
    Set ws = ThisWorkbook.Sheets("MailMerge Sheet")

    ' 设置文件路径：SavePath末尾必须添加路径分隔符\
    SourcePath = "C:\Users\username\Documents\Notice Template.docx"
    SavePath = "C:\Users\username\Documents\Notice Folder\"

    ' 确保保存文件夹存在，不存在则创建
    If Dir(SavePath, vbDirectory) = "" Then
        MkDir SavePath
    End If

    ' 调用或新建Word实例
    On Error Resume Next
    Set wdApp = GetObject(, "Word.Application")
    On Error GoTo 0

    If wdApp Is Nothing Then
        Set wdApp = CreateObject("Word.Application")
    End If
    wdApp.Visible = False ' 调试时可改为True，直观查看Word操作过程
    wdApp.DisplayAlerts = False

    ' 循环处理每行数据
    For i = 2 To ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
        ' 打开模板文档
        Set wdDoc = wdApp.Documents.Open(SourcePath)

        ' 替换<<Today>>标记：明确引用Excel工作表单元格，设置匹配参数确保准确性
        With wdDoc.Content.Find
            .Text = "<<Today>>"
            .Replacement.Text = ws.Cells(i, 1).Value
            .MatchCase = False
            .MatchWholeWord = True
            .Wrap = 1 ' wdFindContinue
            .Execute Replace:=2 ' wdReplaceAll
        End With

        ' 替换<<Employee_Name>>标记
        With wdDoc.Content.Find
            .Text = "<<Employee_Name>>"
            .Replacement.Text = ws.Cells(i, 2).Value
            .MatchCase = False
            .MatchWholeWord = True
            .Wrap = 1
            .Execute Replace:=2
        End With
        
        ' 替换<<Vacation_Used>>标记
        With wdDoc.Content.Find
            .Text = "<<Vacation_Used>>"
            .Replacement.Text = ws.Cells(i, 3).Value
            .MatchCase = False
            .MatchWholeWord = True
            .Wrap = 1
            .Execute Replace:=2
        End With

        ' 生成PDF并保存
        Dim PDFFileName As String
        PDFFileName = "Name of Document " & ws.Cells(i, 2).Value
        wdDoc.ExportAsFixedFormat SavePath & PDFFileName & ".pdf", 17 ' 17对应wdExportFormatPDF

        ' 关闭模板文档，不保存修改
        wdDoc.Close SaveChanges:=False
    Next i

    ' 清理对象并退出Word
    wdApp.Quit
    Set wdDoc = Nothing
    Set wdApp = Nothing
    Set ws = Nothing

    MsgBox "邮件合并及PDF生成已完成！", vbInformation
End Sub

额外调试建议 #

• 开启Word可见性：将wdApp.Visible = True打开，可以直观看到Word中是否完成了标记替换，以及保存操作是否正常执行。
• 添加错误捕获：若仍有问题，可在代码开头添加错误处理，定位具体出错位置：

  On Error GoTo ErrorHandler
  ' ... 原有代码 ...
  ErrorHandler:
      MsgBox "执行出错：" & Err.Description & "，行号：" & Erl
      wdApp.Quit
      Set wdDoc = Nothing
      Set wdApp = Nothing
      Set ws = Nothing
  

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