批量替换文件夹多个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
