|
工作中有很多WORD文档由于写错名称,需要批量替换,
- Dim ArryFile(), nFile '全局变量 nfile初始值为0
- Function searchFile(ByVal fd As Folder)
- Dim fl As File
- Dim subfd As Folder
- Dim i As Integer
- i = fd.Files.Count
- If i > 0 Then
- '--------------------------------------------------
- Set regex1 = CreateObject("VBSCRIPT.REGEXP") 'RegEx为建立正则表达式
- With regex1
- .Global = True '设置全局可用
- .Pattern = "(doc)$" '输入后缀名用|隔开"(xls|xlsx|docx|doc)$
- End With
- '--------------------------------------------------
- ReDim Preserve ArryFile(1 To nFile + i)
- For Each fl In fd.Files
- If regex1.test(fl.Name) = True Then
- nFile = nFile + 1
- ArryFile(nFile) = fl.Path
- End If
- Next
- End If
- If fd.SubFolders.Count = 0 Then Exit Function
- For Each subfd In fd.SubFolders
- searchFile subfd
- Next
- End Function
- Sub 批量修改文件名1()
- Dim fso As FileSystemObject
- Set fso = CreateObject("Scripting.FileSystemObject")
- nFile = 0
- searchFile fso.GetFolder("D:\AAA")
- Set wdapp = CreateObject("Word.Application")
- wdapp.Visible = False
- For Each e In ArryFile
- Debug.Print e
- wdapp.Documents.Open Filename:=e
-
- Debug.Print e & "opened"
- wdapp.Selection.Find.Execute FindText:="BBBB", ReplaceWith:="DDDD", Replace:=wdReplaceAll
- If wdapp.Documents.Saved = False Then wdapp.Documents.Save '?
- Next
- wdapp.Quit
- Set wdapp = Nothing
- End Sub
复制代码 问号这行,提示说对象不支持该属性或方法
请教各位大神,替换后,怎么实现自动保存呢?
如果没有问号那行,最后会提示一堆的保存,要一个个点击确认很烦。
|
|