邮件合并时自动删除值为0、空白或NULL的行

你需要在邮件合并生成单个文档后、导出PDF前，添加逻辑删除值为0、空白或NULL的行项目。以下是修改后的完整宏代码：

Sub MailMergeToPdfBasic()                                                        ' 标记宏开始，命名为"MailMergeToPdf"
' Macro created by Imnoss Ltd
' Modified to remove empty/zero value rows before PDF export
' Last Updated [当前日期]
    Dim masterDoc As Document, singleDoc As Document, lastRecordNum As Long   ' 声明变量
    Set masterDoc = ActiveDocument                                               ' 将当前活动文档设为主文档

    masterDoc.MailMerge.DataSource.ActiveRecord = wdLastRecord                   ' 跳转到最后一个激活的记录
    lastRecordNum = masterDoc.MailMerge.DataSource.ActiveRecord                  ' 获取最后一个激活记录的编号，用于终止循环

    masterDoc.MailMerge.DataSource.ActiveRecord = wdFirstRecord                  ' 跳转到第一个激活的记录
    Do While lastRecordNum > 0                                                   ' 开始循环，直到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                                           ' 将生成的单个文档赋值给变量
        
        ' --- 新增：清理无效行项目 ---
        DeleteEmptyOrZeroRows singleDoc
        
        singleDoc.SaveAs2 _
            FileName:=masterDoc.MailMerge.DataSource.DataFields("DocFolderPath").Value & Application.PathSeparator & _
                masterDoc.MailMerge.DataSource.DataFields("DocFileName").Value & ".docx", _
            FileFormat:=wdFormatXMLDocument                                      ' 保存生成的Word文档
        singleDoc.ExportAsFixedFormat _
            OutputFileName:=masterDoc.MailMerge.DataSource.DataFields("PdfFolderPath").Value & Application.PathSeparator & _
                masterDoc.MailMerge.DataSource.DataFields("PdfFileName").Value & ".pdf", _
            ExportFormat:=wdExportFormatPDF                                      ' 导出为PDF
        singleDoc.Close False                                                    ' 关闭单个文档，释放变量
        If masterDoc.MailMerge.DataSource.ActiveRecord >= lastRecordNum Then     ' 判断是否处理完最后一个记录
            lastRecordNum = 0                                                    ' 若已处理完，设置循环终止条件
        Else
            masterDoc.MailMerge.DataSource.ActiveRecord = wdNextRecord           ' 否则跳转到下一个激活记录
        End If

    Loop                                                                         ' 循环返回
End Sub                                                                          ' 标记宏结束

' --- 新增的子过程：删除值为0、空白或NULL的行 ---
Sub DeleteEmptyOrZeroRows(targetDoc As Document)
    Dim para As Paragraph
    Dim paraText As String
    Dim valueStr As String
    
    ' 从后往前遍历段落，避免删除时索引混乱
    For i = targetDoc.Paragraphs.Count To 1 Step -1
        Set para = targetDoc.Paragraphs(i)
        paraText = Trim(para.Range.Text)
        ' 跳过空段落（仅含换行符的情况）
        If Len(paraText) <= 1 Then GoTo NextPara
        
        ' 提取冒号后的内容作为值（假设格式为"XXX: YYY"）
        If InStr(paraText, ":") > 0 Then
            valueStr = Trim(Mid(paraText, InStr(paraText, ":") + 1))
            ' 检查值是否为空白、0或NULL
            If valueStr = "" Or valueStr = "0" Or UCase(valueStr) = "NULL" Then
                para.Range.Delete ' 删除该段落
            End If
        End If
        
NextPara:
    Next i
End Sub

关键修改说明 #

• 新增子过程DeleteEmptyOrZeroRows：
  • 从后往前遍历文档段落，避免删除段落时打乱索引顺序
  • 针对[项目名]: [值]格式的行，提取冒号后的内容判断有效性
  • 若值为空白、0或NULL（不区分大小写），直接删除对应段落
• 调用时机：在邮件合并生成单个文档后、保存/导出PDF前，调用清理逻辑处理无效行

注意事项 #

• 确保模板行格式统一为项目名: 值结构，若格式不同，需调整子过程中提取值的判断逻辑
• 若行无冒号标识，可直接修改判断条件，比如检查段落内容是否包含无效值

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