VBA实现批量修改Word文档的页脚内容

VBA实现批量修改Word文档的页脚内容

功能示例：

有很多个doc文档，页脚的电话变了，如原电话是4007339339，现在变成4007168339了，要实现批量替换，可使用此程序。

使用说明：

1、 复制下面程序代码到VBA里后，点“工具”－“宏”－“宏”－“change”－“运行”

2、 输入目录(不要输入根目录，要不速度会很慢)

3、 输入要查找的内容

4、 输入的替换成你要的内容

－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－

'下面是程序代码，复制到Word的VBA里

'此子程序放在Word对象里
Option Explicit
Sub change()

      Dim s As String
Dim wb As Object
Dim i As Long
Dim load As String
Dim find As String
Dim change As String

load = InputBox("输入要修改页脚的文件夹路径，自动扫描子文件夹－－－－－－－－－－－－－垃圾桶丁2009-3-8")   '要变更的目录
find = InputBox("输入要查找的页脚内容")   '查找的内容
change = InputBox("请问要替换成什么内容？") '替换的内容

Set wb = Application.FileSearch
    With wb
        .NewSearch
        .LookIn = load
        .SearchSubFolders = True
        .FileName = "*.doc"
        .FileType = msoFileTypeExcelWorkbooks
        If .Execute() > 0 Then
            For i = 1 To .FoundFiles.Count
                On Error Resume Next
            s = .FoundFiles(i)

            Call Macro1(s, find, change)
             Next i
        End If
     End With
End Sub

'此子程序放在模块里

Option Explicit
Sub Macro1(s As String, find As String, change As String)

      
    Documents.Open FileName:=s, ConfirmConversions:=False, _
        ReadOnly:=False, AddToRecentFiles:=False, PasswordDocument:="", _
        PasswordTemplate:="", Revert:=False, WritePasswordDocument:="", _
        WritePasswordTemplate:="", Format:=wdOpenFormatAuto, XMLTransform:=""
    If ActiveWindow.View.SplitSpecial <> wdPaneNone Then
        ActiveWindow.Panes(2).Close
    End If
    If ActiveWindow.ActivePane.View.Type = wdNormalView Or ActiveWindow. _
        ActivePane.View.Type = wdOutlineView Then
        ActiveWindow.ActivePane.View.Type = wdPrintView
    End If
    ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
    If Selection.HeaderFooter.IsHeader = True Then
        ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageFooter
    Else
        ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
    End If
    Selection.find.ClearFormatting
    Selection.find.Replacement.ClearFormatting
    With Selection.find
        .Text = find '查找的内容
        .Replacement.Text = change '替换的内容
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = True
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.find.Execute Replace:=wdReplaceAll
    ActiveWindow.Close (wdSaveChanges)

End Sub