Word VBA邮件合并批量生成PDF末尾多出空白页问题求助

问题根因说明 #

你提供的VBA代码逻辑本身没有错误，不会主动生成额外空白页，空白页几乎都来自邮件合并主模板的格式问题，常见触发场景如下：

• 模板末尾有多余的分页符、分节符
• 模板最后一页末尾残留空段落（回车符），刚好撑满一页的高度
• 模板设置了「节的起始位置为奇数页」，如果合并内容刚好在偶数页结束，Word会自动插入空白页补齐
• 合并字段填充后末尾多出来的空行刚好触发分页阈值

解决方法 #

方法1：修复主模板（优先推荐） #

先从根源解决问题，操作步骤如下：

1. 打开邮件合并主文档，开启格式标记显示（Word「开始」选项卡→段落组的「显示/隐藏编辑标记」按钮，或按快捷键Ctrl+*）
2. 手动删除文档末尾所有多余的空段落、分页符、分节符
3. 右键最后一段的段落标记，选择「段落」→「换行和分页」选项卡，取消勾选所有分页相关的配置项
4. 如果文档用到了分节设置，右键分节符修改属性，把节的起始位置改成「接续本页」

方法2：VBA自动删除生成文件的末尾空白页 #

如果模板无法修改，或者改完还有偶发空白页，可以在Set singleDoc = ActiveDocument之后、保存文件之前插入一段空白页清理代码，修改后的完整代码如下：

Sub MailMergeToPdfBasic()                                                      
    Dim masterDoc As Document, singleDoc As Document, lastRecordNum As Integer
    Dim rng As Range, pageCount As Integer

    Set masterDoc = ActiveDocument                                               

    masterDoc.MailMerge.DataSource.ActiveRecord = wdLastRecord                   
    lastRecordNum = masterDoc.MailMerge.DataSource.ActiveRecord                  

    masterDoc.MailMerge.DataSource.ActiveRecord = wdFirstRecord                
    Do While lastRecordNum > 0                                                   
        masterDoc.MailMerge.Destination = wdSendToNewDocument                    
        masterDoc.MailMerge.DataSource.FirstRecord = masterDoc.MailMerge.DataSource.ActiveRecord              
        masterDoc.MailMerge.DataSource.LastRecord = masterDoc.MailMerge.DataSource.ActiveRecord               
        masterDoc.MailMerge.Execute False                                        
        Set singleDoc = ActiveDocument
        
        ' 新增：清理末尾空白页逻辑开始
        pageCount = singleDoc.Content.Information(wdNumberOfPagesInDocument)
        If pageCount > 1 Then
            ' 定位到最后一页
            Set rng = singleDoc.GoTo(wdGoToPage, wdGoToAbsolute, pageCount)
            ' 检查最后一页是否为纯空白内容
            If Trim(rng.Text) = vbNullString Then
                rng.Bookmarks("\Page").Range.Delete
            End If
        End If
        ' 清理逻辑结束

        singleDoc.SaveAs2 _
            FileName:=masterDoc.MailMerge.DataSource.DataFields("DocFolderPath").Value & Application.PathSeparator & _
                masterDoc.MailMerge.DataSource.DataFields("DocFileName").Value & ".docx", _
            FileFormat:=wdFormatXMLDocument                                      

        singleDoc.ExportAsFixedFormat _
            OutputFileName:=masterDoc.MailMerge.DataSource.DataFields("PdfFolderPath").Value & Application.PathSeparator & _
                masterDoc.MailMerge.DataSource.DataFields("PdfFileName").Value & ".pdf", _
            ExportFormat:=wdExportFormatPDF                                      

        singleDoc.Close False                                                    

        If masterDoc.MailMerge.DataSource.ActiveRecord >= lastRecordNum Then    
            lastRecordNum = 0                                                    
        Else
            masterDoc.MailMerge.DataSource.ActiveRecord = wdNextRecord          
        End If
    Loop                                                                         
End Sub

注：如果你要求所有生成的文件必须为单页，可以直接删除判断空白的逻辑，只要页数大于1就直接删除最后一页即可。

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