当数据源无记录时跳过Word邮件合并的技术实现问询

首先，我们需要修改Word中的VBA宏regular_mail，添加数据源空值检测逻辑，避免因无记录访问DataFields导致的报错，同时保证每个模板都生成对应的打印文件（即使数据源为空）。

关键修改点 #

• 主动检测数据源是否为空：通过定位到第一条记录，判断是否存在有效数据；
• 空数据源处理分支：当数据源为空时，直接生成带标记的空打印文件，然后退出当前模板的处理；
• 修复未初始化变量问题：原代码中i变量未赋值会导致合并逻辑异常，我们补充循环逻辑确保每条记录都能正确处理（如果需要逐条生成文件）。

修改后的完整VBA代码 #

Sub regular_mail()
    Dim sDate As String, StrName As String
    Dim MainDoc As Document, i As Long, fso As Object
    Dim StrMonthPath As String, StrDayPath As String, StrFileName As String
    Dim mmDataSource As MailMergeDataSource
    
    sDate = Format(Now(), "mmddyy")
    Const StrFolderName As String = "C:\Test\Files\"
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set MainDoc = ActiveDocument
    
    With MainDoc.MailMerge
        .Destination = wdSendToNewDocument
        .SuppressBlankLines = True
        
        Set mmDataSource = .DataSource
        ' 检测数据源是否为空：尝试定位到第一条记录
        mmDataSource.ActiveRecord = wdFirstRecord
        If mmDataSource.ActiveRecord = wdNoActiveRecord Then
            ' 处理空数据源：生成带EMPTY标记的空文件
            StrFileName = sDate & "_" & fso.GetBaseName(MainDoc.Name) & "_EMPTY"
            ' 创建基于当前模板的空文档
            Dim emptyDoc As Document
            Set emptyDoc = Documents.Add(Template:=MainDoc.FullName, NewTemplate:=False)
            ' 确保基础保存目录存在
            If Not fso.FolderExists(StrFolderName & "empty_letters\") Then 
                fso.CreateFolder StrFolderName & "empty_letters\"
            End If
            ' 保存空文件
            emptyDoc.SaveAs2 FileName:=StrFolderName & "empty_letters\" & StrFileName, _
                FileFormat:=16, AddToRecentFiles:=False
            emptyDoc.Close
            Set emptyDoc = Nothing
            ' 退出宏，继续处理下一个模板
            GoTo Cleanup
        End If
        
        ' 循环处理每条记录（如需合并为单个文件，可去掉循环，改用默认首尾记录）
        For i = 1 To mmDataSource.RecordCount
            With mmDataSource
                .FirstRecord = i
                .LastRecord = i
                .ActiveRecord = i
                ' 额外保险：捕获字段为空的情况
                On Error Resume Next
                StrName = .DataFields("pk").Value
                StrMonthPath = .DataFields("month_path").Value
                StrDayPath = .DataFields("day_path").Value
                On Error GoTo 0
                
                ' 若关键字段为空，跳过当前记录
                If StrName = "" Then Continue For
            End With
            
            .Execute Pause:=False
            
            ' 构建完整保存路径并确保目录存在
            Dim fullSavePath As String
            fullSavePath = StrFolderName & StrMonthPath & "\" & StrDayPath & "\letters\"
            If Not fso.FolderExists(fullSavePath) Then fso.CreateFolder fullSavePath
            
            ' 保存合并后的文档
            ActiveDocument.SaveAs2 FileName:=fullSavePath & sDate & "_" & fso.GetBaseName(MainDoc.Name) & "_" & i, _
                FileFormat:=16, AddToRecentFiles:=False
            ActiveWindow.Close
        Next i
    End With
    
Cleanup:
    ' 清理对象，避免内存泄漏
    Set mmDataSource = Nothing
    Set fso = Nothing
    Set MainDoc = Nothing
End Sub

代码说明 #

1. 空数据源检测：通过mmDataSource.ActiveRecord = wdFirstRecord尝试定位第一条记录，若返回wdNoActiveRecord则判定为无数据，直接生成带_EMPTY标记的空文件；
2. 循环处理记录：初始化i并遍历所有记录，确保每条数据都生成独立文件（如果需要合并为单个文件，可删除循环，设置.FirstRecord = wdDefaultFirstRecord和.LastRecord = wdDefaultLastRecord）；
3. 错误防护：添加临时错误捕获，避免单个字段为空导致整个模板处理中断；
4. 路径管理：统一处理目录创建逻辑，确保保存路径始终有效。

额外提示 #

• 确保Word已启用宏，且模板已正确关联数据源；
• 空文件的保存路径可根据实际需求调整，比如和正常合并文件放在同一目录，仅通过文件名标记区分；
• 原VBS脚本无需修改，因为我们已在VBA宏内拦截了报错逻辑，脚本会自动继续处理下一个模板。

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