word——VBA编程「建议收藏」

大家好，又见面了，我是你们的朋友全栈君。

最近需要批量操作一些word文件，大约四十几个文件把。一个一个手动操作真的太low了，所以研究了一下word的宏，VBA编写代码，批量操作。
操作就是全选Word内容，给整体加一个书签PO_table。
选中文档中检测二字，加书签PO_jc。
选中 年 月 日，删除该选中内容。

Sub 批量操作WORD()

Dim path          As String
Dim FileName  As String
Dim worddoc   As Document
Dim MyDir       As String
MyDir = "C:\Users\CSY\Documents\Tencent Files9023706\FileRecv\平台需要的\平台需要的"  '文件夹路径根据需要自己修改，需要处理的文件都放该文件夹内
FileName = Dir(MyDir & "\*.docx*", vbNormal)
Do Until FileName = ""
If FileName <> ThisDocument.Name Then
        Set worddoc = Documents.Open(MyDir & "\" & FileName)
        worddoc.Activate
        Call my  '调用宏,换成你自己宏的名字
        worddoc.Close True
        FileName = Dir()
    End If
Loop
Set worddoc = Nothing
End Sub


Sub my()

    Selection.WholeStory '全选
    Options.DefaultHighlightColorIndex = wdNoHighlight
    Selection.Range.HighlightColorIndex = wdNoHighlight '背景色设无
    Selection.Font.Color = vbBlack '字体颜色设黑
    
    Dim strBookmark As String '声明
    strBookmark = "PO_table" '赋值
    ActiveDocument.Bookmarks.Add Name:=strBookmark, Range:=Selection.Range '给选中区域设置书签
    
    With Selection.Find
        .Text = "检测："
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = True
        .MatchWholeWord = False
        .MatchByte = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = False
        .MatchFuzzy = True
    End With '选中文档中文字'检测：'
    Selection.Find.Execute '选中执行
    Selection.MoveRight Unit:=wdCharacter, Count:=1 '移动光标一格

    strBookmark = "PO_jc"
    ActiveDocument.Bookmarks.Add Name:=strBookmark, Range:=Selection.Range
    
    With Selection.Find
        .Text = "     年   月   日 "
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = True
        .MatchWholeWord = False
        .MatchByte = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = False
        .MatchFuzzy = True
    End With '找到     年   月   日
    Selection.Find.Execute
    Selection.Delete'删除选中内容

End Sub