批量修改文件夹中的word文件中的内容

1565785678

请教老师们，怎么批量把文件夹中的word文件中“『正确答案』**”改成『正确答案』。就是去掉『正确答案』后面的字母。

gwjkkkkk

Option Explicit
Sub TEST() '
    Dim ar(), i&, r&, strFileName$, strPath$, Rng As Range
   
    Application.ScreenUpdating = False
   
    strPath = ThisDocument.Path & "\"
    strFileName = Dir(strPath & "*.doc*")
    Do Until strFileName = ""
        If strFileName <> ThisDocument.Name Then
            With Documents.Open(strPath & strFileName)
                Erase ar(): r = 0
                With .Content.Find
                    Do While .Execute(FindText:="『正确答案』") = True
                        .Parent.Select
                        With Selection
                            .EndKey unit:=wdLine, Extend:=wdExtend
                            Set Rng = ActiveDocument.Range(.Start, .End - 1)
                            Rng.Select
                            r = r + 1
                            ReDim Preserve ar(1 To r)
                            Set ar(r) = .Range
                        End With
                    Loop
                End With
                If r Then
                    For i = 1 To r
                        ar(i).Text = "『正确答案』"
                    Next i
                End If
                .Close True
            End With
        End If
        strFileName = Dir
    Loop
        
    Application.ScreenUpdating = True
    Beep
End Sub

gwjkkkkk

请参考附件。。。

cai2532

这个实例实用，收藏了。

taller

h2016

学习学习争取答案