功能示例：

有很多個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