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