邮件合并生成独立文档报错：数据集1发生字段计算错误

一、修复核心语法错误 #

• 路径字符串未闭合：原代码中StrFolder = "C:\test\缺少结尾双引号，导致保存路径无效，直接引发保存失败。修改为：

  StrFolder = "C:\test\"
  

二、调整错误处理逻辑 #

• 原代码开头的On Error Resume Next会掩盖数据源访问错误，导致合并失败却无法定位问题。移除全局错误忽略，仅在处理文件名非法字符时临时启用：

  For j = 1 To Len(StrNoChr)
      On Error Resume Next
      StrName = Replace(StrName, Mid(StrNoChr, j, 1), "_")
      On Error GoTo 0
  Next
  

三、避免依赖ActiveDocument，直接捕获合并文档 #

• 依赖ActiveDocument可能因其他文档激活导致操作对象错误，改用变量接收合并后的文档：

  Dim MergeDoc As Document
  .Execute Pause:=False
  Set MergeDoc = ActiveDocument ' 锁定刚生成的合并文档
  ' 后续操作替换为MergeDoc对象
  With MergeDoc
      .SaveAs FileName:=StrFolder & StrName & ".docx", FileFormat:=wdFormatXMLDocument, AddToRecentFiles:=False
      .SaveAs FileName:=StrFolder & StrName & ".pdf", FileFormat:=wdFormatPDF, AddToRecentFiles:=False
      .Close SaveChanges:=False
  End With
  Set MergeDoc = Nothing
  

四、解决字段计算错误 #

• 记录索引超出范围：原代码固定循环For i = 1 To 3，若数据源记录数不足3会触发错误，改为按实际记录数循环：

  For i = 1 To .DataSource.RecordCount
  

• 合并字段未更新：合并后文档可能存在未计算的字段，添加字段更新代码：

  With MergeDoc
      .Fields.Update ' 更新所有字段，消除计算错误提示
      .SaveAs ...
      ' 其余代码不变
  End With
  

• 字段名不匹配：确认主文档邮件合并字段名与数据源的Anlage字段完全一致，无拼写或大小写差异。

五、完整修正后的代码 #

Sub Merge_To_Individual_Files()
    Application.ScreenUpdating = False
    Dim StrFolder As String, StrName As String, MainDoc As Document, i As Long, j As Long
    Dim MergeDoc As Document
    Const StrNoChr As String = """*./\:?|"
    
    Set MainDoc = ActiveDocument
    With MainDoc
        StrFolder = "C:\test\" ' 修复路径字符串
        ' 目标文件夹不存在则创建
        If Dir(StrFolder, vbDirectory) = "" Then MkDir StrFolder
        
        With .MailMerge
            .Destination = wdSendToNewDocument
            .SuppressBlankLines = True
            
            ' 按实际数据源记录数循环
            For i = 1 To .DataSource.RecordCount
                With .DataSource
                    .FirstRecord = i
                    .LastRecord = i
                    .ActiveRecord = i
                    ' 字段为空则跳过当前记录
                    If Trim(.DataFields("Anlage")) = "" Then GoTo NextRecord
                    StrName = .DataFields("Anlage") & "_" & .DataFields("Anlage")
                End With
                
                On Error GoTo NextRecord
                .Execute Pause:=False
                Set MergeDoc = ActiveDocument
                
                ' 替换文件名非法字符
                For j = 1 To Len(StrNoChr)
                    On Error Resume Next
                    StrName = Replace(StrName, Mid(StrNoChr, j, 1), "_")
                    On Error GoTo 0
                Next
                StrName = Trim(StrName)
                
                With MergeDoc
                    .Fields.Update ' 更新字段避免计算错误
                    .SaveAs FileName:=StrFolder & StrName & ".docx", FileFormat:=wdFormatXMLDocument, AddToRecentFiles:=False
                    .SaveAs FileName:=StrFolder & StrName & ".pdf", FileFormat:=wdFormatPDF, AddToRecentFiles:=False
                    .Close SaveChanges:=False
                End With
                Set MergeDoc = Nothing
NextRecord:
            Next i
        End With
    End With
    Application.ScreenUpdating = True
End Sub

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