Word·VBA实现邮件合并-编程知识

Word·VBA实现邮件合并

制作邮件合并模板

在这里插入图片描述

域名可以使用中文，最终完成的word模板，wps操作步骤类似

VBA实现邮件合并

在Excel启用宏的工作表运行以下代码，读取当前工作表数据，对模板word文档，按工作表表头名称对同一域名写入值，生成新文档

Sub word邮件合并_按域名写入()'读取当前工作表数据，按arr二维数组第1行表头名称，对word文档中同一域名写入值，生成新文档Dim fso As Object, wd As Object, docx$, save_path$, arr, i&, j&, k, v, f, fs
'--------------------参数填写：docx、arr、save_pathdocx = "E:\测试\docx\证明-模板word.docx"  '模板文件路径arr = ActiveSheet.[a1].CurrentRegion.Value     '合并数据，当前工作表save_path = ActiveWorkbook.path & "\结果\"     '文件保存路径Set fso = CreateObject("Scripting.FileSystemObject"): tm = TimerIf Not fso.FolderExists(save_path) Then fso.CreateFolder (save_path)  '创建文件夹Set wd = CreateObject("word.application") ': wd.Visible = True  '默认不可见Set tmpl = wd.Documents.Open(docx)For i = 2 To UBound(arr)With tmplFor j = 1 To UBound(arr, 2)k = arr(1, j): v = arr(i, j)  'k表头/域名，v值Set fs = .Content.Fields  '域集合For Each f In fs'Field.Code域代码，Field.Result域结果If InStr(f.Code.text, k) Then f.result.text = vNextNext.SaveAs save_path & arr(i, 2) & ".docx"End WithNexttmpl.Close: wd.Quit  '关闭文件，退出程序Debug.Print "word邮件合并完成，用时：" & Format(Timer - tm, "0.00")
End Sub