多个word vba批量替换文字（一个文件夹）

多个word批量替换word文字！

Sub 替换N个word文档()
    Dim Dm As Document
    Dim MyPath As String
    Dim MyName As String
    Dim N As Integer
    Application.ScreenUpdating = False
    MyPath = ThisDocument.Path & "/"
    MyName = Dir(MyPath & "*.docx*")
    Do While MyName <> ""
        If MyName <> ThisDocument.Name Then
            N = N + 1
            Set Dm = Documents.Open(MyPath & MyName)
            Selection.Find.ClearFormatting
            Selection.Find.Replacement.ClearFormatting
            With Selection.Find
                .Text = "2022"
                .Replacement.Text = "2023"
                .Forward = True
                .Wrap = wdFindAsk
                .Format = False
                .MatchCase = False
                .MatchWholeWord = False
                .MatchByte = True
                .MatchWildcards = False
                .MatchSoundsLike = False
                .MatchAllWordForms = False
            End With
            Selection.Find.Execute Replace:=wdReplaceAll
            
            With Selection.Find
                .Text = "03月21日"
                .Replacement.Text = "01月12日"
                .Forward = True
                .Wrap = wdFindAsk
                .Format = False
                .MatchCase = False
                .MatchWholeWord = False
                .MatchByte = True
                .MatchWildcards = False
                .MatchSoundsLike = False
                .MatchAllWordForms = False
            End With
            Selection.Find.Execute Replace:=wdReplaceAll
            
            
            
            ActiveDocument.Save
            Dm.Save
            Dm.Close
            Set Dm = Nothing
            MyName = Dir

        End If
    Loop
    Application.ScreenUpdating = True
    MsgBox "批量替换完毕，共计文件数量:" & N
End Sub

Gitee

Gitee链接

赞赏