如何修改VBA代码实现拆分邮件合并文档时同步复制页眉页脚

我明白你的痛点——用邮件合并生成的Word文档拆分单个文件时，原VBA代码只复制了正文，页眉页脚却没跟着过来。问题出在oDoc.Sections.First.Range.Cut这个语句：它只复制了节的正文范围，没有包含页眉页脚，因为页眉页脚是节的独立组成部分，不在正文Range里。

下面是修改后的完整代码，已经解决了页眉页脚复制的问题，我会给你拆解关键改动点：

Sub Splitter_WithHeadersFooters() 
' Based on a Macro created 16-08-98 by Doug Robbins, updated to include headers/footers
Dim Letters As Long 
Dim Counter As Long 
Dim Mask As String 
Dim DocName As String 
Dim oDoc As Document 
Dim oNewDoc As Document 
Dim oSection As Section

Set oDoc = ActiveDocument 
oDoc.Save 

' 获取总节数（每个邮件合并的信件对应一个节）
Letters = oDoc.Sections.Count

Counter = 1 
While Counter <= Letters
    DocName = Format(Date, "ddMMyy") _
              & "-" & LTrim$(Str$(Counter)) & ".docx"
              
    ' 定位到当前要提取的节
    Set oSection = oDoc.Sections(Counter)
    
    ' 创建新文档
    Set oNewDoc = Documents.Add
    
    ' 复制整个节的所有内容（包括页眉、页脚和正文）
    oSection.Range.Copy
    oNewDoc.Range.Paste
    
    ' 清理末尾可能多余的段落标记，避免空行
    With oNewDoc.Range
        If .End > .Start Then
            .MoveEnd Unit:=wdCharacter, Count:=-1
            If .Characters.Last = Chr(13) Then .Characters.Last.Delete
        End If
    End With
    
    ' 保存新文档到原文档所在路径
    oNewDoc.SaveAs FileName:=oDoc.Path & Application.PathSeparator & DocName, _
                   FileFormat:=wdFormatXMLDocument, AddToRecentFiles:=False
                   
    ' 关闭新文档
    oNewDoc.Close SaveChanges:=wdDoNotSaveChanges
    
    Counter = Counter + 1 
Wend 

' 关闭原合并文档，不保存修改
oDoc.Close wdDoNotSaveChanges 
End Sub

关键改动说明： #

• 替换Cut为Copy并复制完整节Range：
  原代码用Cut会删除原文档的节（虽然最后不保存原文档，但不够稳妥），现在直接复制oSection.Range——这个范围包含了节的所有元素：正文、页眉、页脚、页边距设置等，完美解决了页眉页脚丢失的问题。
• 更准确的节数获取方式：
  直接用oDoc.Sections.Count获取总节数，比通过Selection.Information更可靠，避免因光标位置导致的错误。
• 添加末尾空行清理：
  复制节之后可能会在文档末尾多一个段落标记，这段代码会自动移除，保证生成的单个文档更整洁。
• 明确保存格式：
  显式指定FileFormat:=wdFormatXMLDocument对应docx格式，和文件名的后缀保持一致，避免格式混淆。

如果你的邮件合并文档里每个信件确实是独立的节（这是邮件合并生成文档的默认设置），这个代码应该能完美满足你的需求。

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