Sub 快速保存() Path1 = "E:\" "设置文件夹路径 Set objshell = CreateObject("Shell.Application") Set objFolder = objshell.browseForFolder(0, "选择文件夹", 0, Path1) IfNot objFolder IsNothingThen FolderPath = Path1 & objFolder
Dim myExp As RegExp Dim AllContent Set myExp = New RegExp AllContent = ActiveDocument.Content With myExp '利用正则表达式提取案号以作为文件夹名和文件名' .Pattern = "((2|\(2).+?号" .Global = False Set myMsg = .Execute(AllContent)
ForEach m In myMsg filename_ = m Next EndWith Set wdApp = Nothing
Path2 = FolderPath & "\" & filename_ "判断是否已经存在文件 Set FSO = CreateObject("Scripting.FileSystemObject") If FSO.FolderExists(Path2) = TrueThen If (MsgBox("已存在该文件,是否覆盖?", vbYesNo)) = vbNo Then Cancel = True GoTo k Else GoTo l EndIf Else MkDir (FolderPath & "\" & filename_) "不存在则创建文件夹 EndIf l: ActiveDocument.SaveAs FileName:=FolderPath & "\" & filename_ & "\" & filename_ k: End Sub
Sub 快速保存() Dim myExp As RegExp '利用正则表达式提取案号以作为文件夹名和文件名' Dim AllContent Set myExp = New RegExp AllContent = ActiveDocument.Content With myExp .Pattern = "((2|\(2).+?号"'正则表达式' .Global = False Set myMsg = .Execute(AllContent)
Set myExp = New RegExp AllContent = ActiveDocument.Content With myExp .Pattern = "((2|\(2).+?号"'正则表达式' .Global = False Set myMsg = .Execute(AllContent)
Sub test() Dim wdApp As Word.Application Dim wddocument As Word.document Dim myExp As RegExp Dim AllContent For k = 2To Application.CountA(Sheet1.Range("D:D")) file_ = Sheet1.Range("D" & k) Set wdApp = New Word.Application Set wddocument = wdApp.Documents.Open(file_) With wdApp Set myExp = New RegExp AllContent = wddocument.Content With myExp .Pattern = Sheet1.Range("B1") .Global = False Set myMsg = .Execute(AllContent)
ForEach m In myMsg Sheet1.Range("E" & k) = m Next EndWith .Documents.Close .Quit EndWith Set wdApp = Nothing Next EndSub