如何使用VBA批量替换文件夹下Word文件页眉页脚中的指定文本

原代码仅作用于Word正文区域，原因是默认选中的是正文故事范围，调整逻辑为遍历所有页眉页脚的故事范围执行替换即可，修改后完整代码如下：

Sub FindAndReplaceHeaderFooterInFolder()
  Dim objDoc As Document
  Dim objStory As Range
  Dim strFile As String
  Dim strFolder As String
  Dim strFindText As String
  Dim strReplaceText As String
 
  ' 弹窗获取文件夹路径、查找文本、替换文本
  strFolder = InputBox("请输入文件夹路径:")
  If strFolder = "" Then Exit Sub ' 点击取消直接退出
  strFile = Dir(strFolder & "\" & "*.docx", vbNormal)
  strFindText = InputBox("请输入需要查找的文本:")
  If strFindText = "" Then Exit Sub
  strReplaceText = InputBox("请输入替换后的文本:")
 
  ' 遍历文件夹内所有docx文件
  While strFile <> ""
    Set objDoc = Documents.Open(FileName:=strFolder & "\" & strFile)
    With objDoc
      ' 遍历所有故事范围，仅处理页眉页脚相关范围
      For Each objStory In .StoryRanges
        Select Case objStory.StoryType
          ' 覆盖常规页眉页脚、首页独立页眉页脚、偶数页独立页眉页脚
          Case wdHeaderFooterPrimary, wdHeaderFooterFirstPage, wdHeaderFooterEvenPages
            With objStory.Find
              .Text = strFindText
              .Replacement.Text = strReplaceText
              .Forward = True
              .Wrap = wdFindContinue
              .Format = False
              .MatchCase = False
              .MatchWholeWord = False
              .MatchWildcards = False
              .MatchSoundsLike = False
              .MatchAllWordForms = False
              .Execute Replace:=wdReplaceAll
            End With
          End Select
      Next objStory
      .Save
      .Close
    End With
    strFile = Dir()
  Wend
  MsgBox "批量替换完成"
End Sub

关键修改说明 #

• 移除了原代码中操作Selection对象的逻辑，避免误修改正文内容
• 新增遍历StoryRanges集合的逻辑，仅筛选页眉页脚类型的范围执行替换，支持包含「首页不同」「奇偶页不同」设置的Word文档
• 新增了输入为空的退出判断，避免无效运行，最后增加完成提示

注意事项 #

• 运行代码前请提前备份目标文件夹内的Word文件，避免误操作丢失内容
• 如果需要处理.doc格式文件，将Dir参数里的*.docx改为*.doc即可
• 运行时需要在Word的宏设置中启用宏权限

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