Word·VBA文档合并

目录

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

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

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

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

vbnet 复制代码
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偶尔运行报错,原因未知

vbnet 复制代码
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 方法插入指定文件

vbnet 复制代码
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
  • 合并结果:与方法2一致
  • 3种方法对比
文档合并 方法1 方法2 方法3
耗时秒数 4.41 5.48 0.61
  • 方法3不但生成结果与方法2一致,而且代码运行速度快数倍
相关推荐
Uluoyu6 小时前
word、pdf文档内容提取工具类
java·pdf·word
sanshizhang7 小时前
word文档转pdf开源免费,可自定义水印
pdf·开源·word
lijingguang15 小时前
excel和word文件默认用office打开而不是用wps
word·excel·wps
Uluoyu1 天前
支持Word (doc/docx) 和 PDF 转成一张垂直拼接的长PNG图片工具类
java·pdf·word
VBAMatrix1 天前
报告工具更新!Word附注一键期末转期初
word·办公自动化·审计报告·审计·会计师事务所·报告工具·word附注
恶猫1 天前
Polaris Officev9.9.12全功能解锁版
pdf·word·excel·ppt·office·办公·打工
Access开发易登软件2 天前
Access调用Azure翻译:轻松实现系统多语言切换
后端·python·低代码·flask·vba·access·access开发
睿思达DBA_WGX3 天前
使用 python-docx 库操作 word 文档(3):读取word文档的内容
python·word
cehuishi95273 天前
excel中关联word邮件合并使用
word·excel·批量打印·邮件合并
SoberChina3 天前
Jasperreport 导出word 多个element重叠部分导致不显示(不支持)
pdf·word·jaspersoft·模版打印