【转载+原创】批量删除word中特定字符后的所有内容

需求：多个word文档结尾有编辑、广告等无用信息，需要将从“编辑：”开始到文档结尾的内容全部删除

1. 在word中打开宏录制，然后查找并选中“编辑：”，然后按Shift选中这里到文档末尾的全部内容，选中后按Delete删除。完成以上操作后停止宏录制，得到的宏为：

'
' 宏1 宏
'
'
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "编辑："
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = False
        .CorrectHangulEndings = False
        .HanjaPhoneticHangul = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = False
        .MatchFuzzy = False
    End With
    Selection.Find.Execute
    Selection.EndKey Unit:=wdStory, Extend:=wdExtend
    Selection.Delete Unit:=wdCharacter, Count:=1
End Sub

2. 接下来是引用↓这个网址上的内容

https://www.cnblogs.com/huangcong/p/13384560.html

Sub 批量操作WORD()
   Dim path          As String
   Dim FileName  As String
   Dim worddoc   As Document
   Dim MyDir       As String
   MyDir = "G:\360data\重要数据\桌面\新建文件夹 (2)"  '文件夹路径根据需要自己修改，需要处理的文件都放该文件夹内
   FileName = Dir(MyDir & "\*.doc*", vbNormal)
   Do Until FileName = ""
   If FileName <> ThisDocument.Name Then
         Set worddoc = Documents.Open(MyDir & "\" & FileName)
         worddoc.Activate
         Call 处理WORD  '调用宏,换成你自己宏的名字
         worddoc.Close True
         FileName = Dir()
    End If
   Loop
Set worddoc = Nothing
End Sub
'======================下面的宏换成你自己的宏=================================
Sub 处理WORD()
 ActiveDocument.Paragraphs(1).Range.Select
 Selection.Font.Size = 72
End Sub

把相应的部分换成我自己的就ok了，最后得到：

Sub 宏1()
'
' 宏1 宏
'
'
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "编辑："
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = False
        .CorrectHangulEndings = False
        .HanjaPhoneticHangul = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = False
        .MatchFuzzy = False
    End With
    Selection.Find.Execute
    Selection.EndKey Unit:=wdStory, Extend:=wdExtend
    Selection.Delete Unit:=wdCharacter, Count:=1
End Sub
Sub 批量操作WORD()
   Dim path          As String
   Dim FileName  As String
   Dim worddoc   As Document
   Dim MyDir       As String
   MyDir = "C:\Users\XXX\Desktop\test\1"  '文件夹路径根据需要自己修改，需要处理的文件都放该文件夹内
   FileName = Dir(MyDir & "\*.doc*", vbNormal)
   Do Until FileName = ""
   If FileName <> ThisDocument.Name Then
         Set worddoc = Documents.Open(MyDir & "\" & FileName)
         worddoc.Activate
         Call 宏1  '调用宏,换成你自己宏的名字
         worddoc.Close True
         FileName = Dir()
    End If
   Loop
Set worddoc = Nothing
End Sub

可喜可乐~ 可喜可乐~保存后在宏列表里运行就OK了