word批量替换指定文字（宏）

Private Sub CommandButton1_Click()

    '关闭屏幕刷新

    Application.ScreenUpdating = False

    '定义变量

    Dim myFile$, myPath$, i%, myDoc As Object, myAPP As Object, txt$, Re_txt$

    '设置应用对象，建立临时进程

    Set myAPP = New Word.Application

    '显示选择文件夹对话框

    With Application.FileDialog(msoFileDialogFolderPicker)

        .Title = "选择目标文件夹"

        If .Show = -1 Then

            '读取选择的文件路径

            myPath = .SelectedItems(1)

        Else

            Exit Sub

        End If

    End With

    '文件夹目录和文件完整路径

    myPath = myPath & ""

    myFile = Dir(myPath & "\*.docx")

    '获取被替换的文字

    txt = InputBox("需要替换的文字:")

    '获取替换文件

    Re_txt = InputBox("替换成:")

    '显示打开文档

    myAPP.Visible = True '是否显示打开文档

    '循环处理文件夹中的全部文件

    Do While myFile <> "" '文件不为空

        '打开文件

        Set myDoc = myAPP.Documents.Open(myPath & "\" & myFile)

        '判断文件是否受保护，仅对未受保护的文件有效

        If myDoc.ProtectionType = wdNoProtection Then

            '查找替换

            With myDoc.Content.Find

                .Text = txt

                .Replacement.Text = Re_txt

                .Forward = True

                .Wrap = 2

                .Format = False

                .MatchCase = False

                .MatchWholeWord = False

                .MatchByte = True

                .MatchWildcards = False

                .MatchSoundsLike = False

                .MatchAllWordForms = False

                .Execute Replace:=2

            End With

        End If

        '设置文件窗口状态，避免再次打开时被隐藏

        Application.WindowState = wdWindowStateNormal

        '保存并关闭文档

        myDoc.Save

        myDoc.Close

        myFile = Dir

    Loop

     '关闭临时进程

    myAPP.Quit

    '打开屏幕更新

    Application.ScreenUpdating = True

    '输出提示信息

    MsgBox ("全部替换完毕!")

End Sub