首页 > 代码库 > 批量替换文件夹多个doc中的字符串

批量替换文件夹多个doc中的字符串

‘ --------------------------------------------------------------------------------
‘ 用来替换文件夹多个doc中的字符串
‘ 作者:wishmo@tom.com
‘ 日期:2017年4月25日
‘ --------------------------------------------------------------------------------
‘ --------------------------------------------------------------------------------
‘ 用来替换单个doc中的字符串
‘ 作者:wishmo@tom.com
‘ 日期:2017年4月25日
‘ --------------------------------------------------------------------------------
Function docReplace(fullpath, searchStr, replaceStr)
    Application.ScreenUpdating = False
    Dim myDoc As Document
    Set myDoc = Documents.Open(FileName:=(fullpath))
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = searchStr
        .Replacement.Text = replaceStr
        .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
    myDoc.Save
    myDoc.Close
    Set myDoc = Nothing
    Application.ScreenUpdating = True
End Function
‘ --------------------------------------------------------------------------------
‘ 用来获取文件夹路径
‘ 作者:wishmo@tom.com
‘ 日期:2017年4月25日
‘ --------------------------------------------------------------------------------
Function getDir()
    Dim myPath As String
    ‘ 选择目标文件夹
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "选择目标文件夹"
        If .Show = -1 Then
            myPath = .SelectedItems(1)
        Else
            Exit Function
        End If
    End With
    getDir = myPath
End Function
‘ --------------------------------------------------------------------------------
‘ 批量替换多个doc中的字符串
‘ 作者:wishmo@tom.com
‘ 日期:2017年4月25日
‘ --------------------------------------------------------------------------------
Sub MultiDocReplace()
    Application.ScreenUpdating = True
    Dim fpath As String, myPath As String
    myPath = getDir()
    docFile = Dir(myPath & "\*.doc*", vbDirectory)
    
    Do While docFile <> ""   ‘ 开始循环。
        fpath = myPath & "\" & docFile
        Call docReplace(fpath, "孝感", "荆州")
        docFile = Dir
    Loop
    Application.ScreenUpdating = True
End Sub


来自为知笔记(Wiz)


批量替换文件夹多个doc中的字符串