之前写过的一篇使用《python实现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, fs, f
'--------------------参数填写:docx、arr、save_path
docx = "E:\测试\docx\证明-模板.docx" '模板文件路径
arr = ActiveSheet.[a1].CurrentRegion.Value '合并数据,当前工作表
save_path = ActiveWorkbook.path & "\结果\" '文件保存路径
Set fso = CreateObject("Scripting.FileSystemObject"): tm = Timer
If 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 tmpl
For 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 = v
Next
Next
.SaveAs save_path & arr(i, 2) & ".docx"
End With
Next
tmpl.Close: wd.Quit '关闭文件,退出程序
Debug.Print "word邮件合并完成,用时:" & Format(Timer - tm, "0.00")
End Sub
- 参考资料:
《Range 对象 (Word)》、《Field 对象 (Word)》
举例
Excel工作表表头与Word文档域名相同
- 合并结果,20个文件生成用时4.62秒
VBA邮件合并_按顺序写入
在Excel启用宏的工作表
运行以下代码,读取当前工作表数据,对模板word文档,按文档中域的顺序写入值,生成新文档文章来源:https://www.toymoban.com/news/detail-816790.html
Sub word邮件合并_按顺序写入()
'读取当前工作表数据,按顺序对word文档中域写入值,生成新文档
Dim fso As Object, wd As Object, docx$, save_path$, arr, i&, j&, fs, f
'--------------------参数填写:docx、arr、save_path
docx = "E:\测试\docx\证明\证明-模板2.docx" '模板文件路径
arr = ActiveSheet.[a1].CurrentRegion.Value '合并数据,当前工作表
save_path = ActiveWorkbook.path & "\结果2\" '文件保存路径
Set fso = CreateObject("Scripting.FileSystemObject"): tm = Timer
If 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 tmpl
j = 1: Set fs = .Content.Fields '域集合
If fs.Count >= 1 Then
Set f = fs(1)
While Not f Is Nothing
j = j + 1: f.result.text = arr(i, j)
Set f = f.Next '下一个
Wend
End If
.SaveAs save_path & arr(i, 2) & ".docx"
End With
Next
tmpl.Close: wd.Quit '关闭文件,退出程序
Debug.Print "word邮件合并完成,用时:" & Format(Timer - tm, "0.00")
End Sub
- 参考资料:
《Field.Next 属性 (Word)》
举例
在原本的模板上添加了5个域,也可使用Next
域,不过Next
域在模板中不可见,故推荐使用原来的MergeField
域
文章来源地址https://www.toymoban.com/news/detail-816790.html
- 合并结果,20个文件生成用时4.58秒
到了这里,关于Word·VBA实现邮件合并的文章就介绍完了。如果您还想了解更多内容,请在右上角搜索TOY模板网以前的文章或继续浏览下面的相关文章,希望大家以后多多支持TOY模板网!