Option Explicit
Sub mergeFiles()
Dim filename As String
Dim doc As Document
Set doc = ThisDocument
\'清除当前文档中的内容
doc.Content.Delete
\'遍历目录中全部doc文件,调用mergeDoc过程处理
ChDir ("C:\test\")
filename = Dir("*.doc")
Do While Len(filename)
mergeDoc filename, doc
filename = Dir
Loop
End Sub
Sub mergeDoc(filename As String, doc As Document)
Dim app As Application
Dim newDoc As Document
Dim sec As Section
Set app = Application
\'打开要添加的doc文件
Set newDoc = app.Documents.Open(filename)
\'在当前文档中新建一节
Set sec = doc.Sections.Add
\'将doc文件的内容拷贝到剪贴板中
newDoc.Content.Copy
\'将doc文件的页面设置拷贝到当前节
sec.PageSetup = newDoc.PageSetup
\'将带格式的内容从剪贴板拷贝到当前文档
sec.Range.PasteAndFormat wdFormatOriginalFormatting
\'关闭doc文档
newDoc.Close
End Sub
需要删除中文注释,并修改目录地址,成功合并文件并保留格式
发表评论