|
|
楼主 |
发表于 2013-8-21 21:40
|
显示全部楼层
本帖最后由 zhanglei1371 于 2013-8-21 22:07 编辑
11. 批量文件替换：本方法用递归的形式来完成文件目录下的word文档替换。大家应该知道，word2003中可用filesearch方法对文件下的子目录中的文档进行操作，但是到了07版之后就没用了。当时请教了不少人也没得到回复。费了不少劲从网上找到Excel的操作，取其本源代码转换成了word的代码，本方法适用于各个版本。
而且在替换中可采用两种方式：
一、通配符替换，熟悉替换的朋友应该都知道；
二、正则表达式替换：此为本人原创的方法，整合到此过程中，通过对话框形式可选择正则方法，用于弥补通配符的不足，但是需要指出的是，正则替换会破坏掉原文的格式。对于需要保留格式的文章勿选择。
Sub 批量文件夹替换()
Dim FID As String
Dim REP As String
Dim TF As Boolean
On Error Resume Next
If MsgBox("要使用正则替换吗？", vbYesNo + vbExclamation, "正则判断") = vbYes Then
TF = True
FID = InputBox("请输入要查找的目标：【正则模式】", "正则查找...", FID)
If FID = "" Then Exit Sub
REP = InputBox("请输入要替换为的表达式：【正则模式】", "正则替换替换...", REP)
Else
FID = InputBox("请输入要查找的目标：", "查找...", FID)
If FID = "" Then Exit Sub
REP = InputBox("请输入要替换为的表达式", "替换...", REP)
End If
' If REP = "" Then Exit Sub
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "请定位要处理的文件夹..."
If .Show <> -1 Then Exit Sub
bc = .SelectedItems(1)
End With
bc0 = Left(bc, 3)
Debug.Print bc, bc0
ChDrive bc0
ChDir (bc)
F = Dir("*.doc")
Do While F <> ""
With Documents.Open(bc & Application.PathSeparator & F, Visible:=True)
Application.ScreenUpdating = False
'*---------------------测试代码------------------------------------*
If TF = True Then
Call 正则替换(FID, REP)
Else
Call 查找替换子过程(FID, REP)
End If
'ActiveDocument.content.Find.Execute FID, , , 2, , , , , , REP, 2
'*-------------------------------------------------------------------*
Application.ScreenUpdating = False
.Close True
End With
F = Dir
Loop
查找子目 bc, FID, REP, TF
End Sub
Function 查找替换子过程(FID, REP)
ActiveDocument.Content.Find.Execute FID, , , 2, , , , , , REP, 2
End Function
Function 查找子目(ByVal TD As String, FID As String, REP As String, TF As Boolean)
Dim fs As New FileSystemObject
If fs.FolderExists(TD) Then
If Len(fs.GetFolder(TD)) = 0 Then
Debug.Print "文件夹" & TD & " 是空的！"
Else
Dim Zi
For Each Zi In fs.GetFolder(TD).SubFolders
For Each F In Zi.Files
'*--------------------------测试代码------------------------------------*
If F.Type = "Microsoft Word 文档" Then
With Documents.Open(CStr(F), Visible:=True)
Application.ScreenUpdating = False
'*-----------------------------------------------------------------------------------------------*
If TF = True Then
Call 正则替换(FID, REP)
Else
Call 查找替换子过程(FID, REP)
End If
'*-----------------------------------------------------------------------------------------------*
Application.ScreenUpdating = True
'*-------------------------------------------------------------------*
.Close True
End With
End If
Next
查找子目 Zi, FID, REP, TF '！递归！
Next
End If
End If
End Function
Function 正则替换(Pattern As String, tar As String)
Dim a As Object
Dim S As Range
Set S = IIf(Selection.Type = wdSelectionIP, ActiveDocument.Content, Selection.Range)
Set a = CreateObject("VBscript.regexp")
With a
.Global = True
.MultiLine = True
.Pattern = Pattern
S = .Replace(S, tar)
End With
S.Select
Set S = Nothing
Set a = Nothing
End Function
|
|
楼主: zhanglei1371
[复制链接]
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2013-8-21 21:31
