Word·VBA文档合并-Toy模板网

这篇具有很好参考价值的文章主要介绍了Word·VBA文档合并。希望对大家有所帮助。如果存在错误或未考虑完全的地方，请大家不吝赐教，您也可以点击"举报违法"按钮提交疑问。

之前的文章《Word·VBA实现邮件合并》虽然可以生成邮件合并文档结果，但是不能像《python实现word邮件合并》一样，最终所有结果合并为1个文档，那么只能用vba实现文档合并功能

以下代码在Word启用宏的文档中运行

1，复制法，不保留原文档格式

Range.InsertAfter 方法只能插入文本，因此合并结果不保留原文档格式

Sub 合并文档_复制法()
    '合并文件夹中所有doc*文档，并保存文档至该文件夹；但不保留原文档格式
    Dim file_path$, file_name$, docx As Document, f As Document
'--------------------参数填写：
    file_path = "E:\测试\docx\结果\"  '文件夹
    file_name = Dir(file_path & "*.doc*"): tm = Timer
    Set docx = Documents.Add    '新建文档，合并文档
    Application.ScreenUpdating = False  '关闭屏幕更新，加快程序运行
    Do While file_name <> ""
        Set f = Documents.Open(file_path & file_name)
        docx.Content.InsertAfter f.Content  '将文档内容复制到合并文档末尾
        f.Close (False)
        file_name = Dir  '下一个文件名
    Loop
    docx.SaveAs FileName:=file_path & "合并文档.docx"  '保存
    docx.Close
    Application.ScreenUpdating = True
    Debug.Print "文件夹文档合并完成，用时：" & Format(Timer - tm, "0.00")  '耗时
End Sub

合并结果

2，复制法，保留原文档格式

rng.Paste偶尔运行报错，原因未知

Sub 合并文档_复制法2()
    '合并文件夹中所有doc*文档，并保存文档至该文件夹；保留原文档格式
    Dim file_path$, file_name$, docx As Document, f As Document, rng As Range
'--------------------参数填写：
    file_path = "E:\测试\docx\结果\"  '文件夹
    file_name = Dir(file_path & "*.doc*"): tm = Timer
    Set docx = Documents.Add    '新建文档，合并文档
    Application.ScreenUpdating = False  '关闭屏幕更新，加快程序运行
    Do While file_name <> ""
        Set f = Documents.Open(file_path & file_name)
        Set rng = f.Content: rng.Copy
        Set rng = docx.Content
        rng.Collapse Direction:=wdCollapseEnd  '结束位置
        rng.Paste: rng.InsertAfter Chr(12)     '粘贴，并插入换页符
        f.Close (False)
        file_name = Dir  '下一个文件名
    Loop
    docx.SaveAs FileName:=file_path & "合并文档.docx"  '保存
    docx.Close
    Application.ScreenUpdating = True
    Debug.Print "文件夹文档合并完成，用时：" & Format(Timer - tm, "0.00")  '耗时
End Sub

合并结果

3，插入法，保留原文档格式

Selection.InsertFile 方法插入指定文件文章来源地址https://www.toymoban.com/news/detail-849479.html

Sub 合并文档_插入法()
    '合并文件夹中所有doc*文档，并保存文档至该文件夹；保留原文档格式
    Dim file_path$, file_name$, docx As Document
'--------------------参数填写：
    file_path = "E:\测试\docx\结果\"  '文件夹
    file_name = Dir(file_path & "*.doc*"): tm = Timer
    Set docx = Documents.Add    '新建文档，合并文档
    Application.ScreenUpdating = False  '关闭屏幕更新，加快程序运行
    Do While file_name <> ""
        Selection.InsertFile FileName:=file_path & file_name, Link:=False  '所有文档
        Selection.InsertBreak Type:=wdPageBreak  '插入换页符
        file_name = Dir  '下一个文件名
    Loop
    docx.SaveAs FileName:=file_path & "合并文档.docx"  '保存
    docx.Close
    Application.ScreenUpdating = True
    Debug.Print "文件夹文档合并完成，用时：" & Format(Timer - tm, "0.00")  '耗时
End Sub