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

海哥0998

已于 2023-01-31 17:22:26 修改

阅读量2.4k

点赞数 2

分类专栏：笔记文章标签： word 开发语言

于 2022-12-27 14:40:53 首次发布

@hayratjan

本文链接：https://blog.csdn.net/hayratjanmmmm/article/details/127481175

版权

笔记专栏收录该内容

3 篇文章

订阅专栏

本文介绍了一种使用VBA宏批量替换多个Word文档中特定文本的方法。通过简单的脚本即可实现对指定路径下所有.docx文件中目标字符串的全局替换，有效提升工作效率。

摘要生成于 C知道，由 DeepSeek-R1 满血版支持，前往体验 >

多个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