Sub DrawObjAndSave()
DocX = False
SaveDocName = "提取并保存" '保存的新文档的名字可以自己更改
SaveDoc = "C:\" & SaveDocName & ".doc" '保存的新文档的名字可以自己更改
Documents.Add DocumentType:=wdNewBlankDocument
Documents.Save SaveDoc
Set MyDocSave = Documents.Open(SaveDoc)
Path = "C:\test\" '目标文件所在的目录,可自行修改
MyDoc = Path & Dir(Path & "*.doc") '如果还要包括docx类型的话,则为 MyDoc = Path & Dir(Path & "*.docx")
DoAgain:
Do While MyDoc <> Path
Set MyDocOpen = Documents.Open(MyDoc)
Selection.Find.ClearFormatting
Do
With Selection.Find
.Text = "*^13" '*可以替换成特定的需要查找的目标内容的通配符表达式
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
End With
Selection.Find.Execute
Selection.Copy
Windows(SaveDocName).Activate
Selection.Paste
MyDocSave.Save
Loop While Selection.Find.Found
MyDocOpen.Saved = True
MyDocOpen.Close
If Not DocX Then
MyDoc = Path & Dir(Path & "*.docx")
DocX = True
GoTo DoAgain
End If
MyDocSave.Close
MsgBox "处理完毕!", vbInformation + vbOKOnly, "消息"
Applicatiction.quit
End Sub
追问谢谢回答,但调试出错。
追答这个才是标准的VBA.但不知道你调试时为啥会出错?在我的版本中是正确的。
Selection.Start = a + 1
Selection.End = b
这是不标准的。
追问再次感谢,你回答的很详细。我也把这段代码复制下来慢慢研究。现在提示“Do没有Loop”