|
Dim ArrFiles()
Dim FileCount%
Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
Dim myPas As String, myPath As String, i As Integer, myDoc As Document
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "选择目标文件夹"
If .Show = -1 Then
myPath = .SelectedItems(1)
Else
Exit Sub
End If
End With
'myPas = InputBox("请输入打开密码：")（有密码则去掉'加上这行）
'把找到的文件读入数组中
Dim fs As Object, fd As Object
Set fs = CreateObject("Scripting.FileSystemObject")
Set fd = fs.GetFolder(myPath)
FileCount = 0
SearchFiles fd
'循环数组
For i = 1 To FileCount
Set myDoc = Documents.Open(FileName:=ArrFiles(i))
'Set myDoc = Documents.Open(FileName:=ArrFiles(i), Passworddocument:=myPas)（上下两行，有密码用这行）
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "一水秋风"
.Replacement.Text = "www.vkan.net"
.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
Next
Application.ScreenUpdating = True
End Sub
Sub SearchFiles(ByVal fd As Object)
Dim fl As Object
Dim sfd As Object
For Each fl In fd.Files
If InStr(Right(fl.Path, Len(fl.Path) - InStrRev(fl.Path, ".")), "doc") > 0 Then
FileCount = FileCount + 1
ReDim Preserve ArrFiles(1 To FileCount)
ArrFiles(FileCount) = fl.Path
End If
Next
If fd.subfolders.Count = 0 Then Exit Sub
For Each sfd In fd.subfolders
SearchFiles sfd
Next
Set fl = Nothing
Set sfd = Nothing
End Sub
|