在 Excel 中模拟 Word 的邮件合并功能

邮件合并是 Word 中最重要的功能。通俗来讲，邮件合并就是把数据填到模板上，与财务中的套打一样。如果您想在 Excel 中使用 VBA 来模拟 Word 邮件合并功能，步骤如下：

1. 准备一份 Excel 数据列表。
2. 新建一个 Word 空白文档，在需要插入 Excel 数据字段的位置插入书签，为方便操作，书签名称可以跟 Excel 中的列字段一致，调整好整个模板的格式。
3. 在 Excel 中使用 VBA 插入编辑好的 Word 模板，遍历 Excel 数据列表中的每条记录，然后将每条记录的列字段内容分配给对应的书签。

在 Excel 中模拟 Word 的邮件合并功能

本示例使用后期绑定，使用 VBA 在 Excel 中模拟 Word 的邮件合并功能，效果如下：

示例代码

Sub WordMailMerge()
    '网址：https://oacourse.com/excel/mail-merge-in-excel-vba/
    '后期绑定，无需引用
    
    '定义变量
    Dim wdApp As Object
    Dim wdDoc As Object
    Dim MyRange As Range
    Dim MyCell As Range
    Dim txtBJ As String
    Dim txtXM As String
    Dim txtXH As String
    Dim txtYW As String
    Dim txtSX As String
    Dim txtYY As String
    Dim MyBk
    
    '关闭屏幕更新，加快程序运行速度
    Application.ScreenUpdating = False
    
    '新建一个Word实例
    Set wdApp = CreateObject("Word.Application")
    
    With wdApp
        '设置Word可见
        .Visible = True
        '激活Word
        '.Activate
        '新增空白文档
        Set wdDoc = .Documents.Add
    End With
    
    '设置要循环的单元格范围
    Set MyRange = ThisWorkbook.Sheets("成绩单").Range("A2:A5")
    
    With wdApp.ActiveWindow.Selection
        '循环每一个单元格
        For Each MyCell In MyRange.Cells
            '对变量赋值
            With MyCell
                txtBJ = .Value
                txtXM = .Offset(, 1).Value
                txtXH = .Offset(, 2).Value
                txtYW = .Offset(, 3).Value
                txtSX = .Offset(, 4).Value
                txtYY = .Offset(, 5).Value
            End With
            '插入模板文档
            .InsertFile ThisWorkbook.Path & "\" & "小学成绩单.docx"
            
            '在每个书签处填入变量的值
            .GoTo -1, , , "班级"
            .TypeText txtBJ
            .GoTo -1, , , "姓名"
            .TypeText txtXM
            .GoTo -1, , , "学号"
            .TypeText txtXH
            .GoTo -1, , , "语文"
            .TypeText txtYW
            .GoTo -1, , , "数学"
            .TypeText txtSX
            .GoTo -1, , , "英语"
            .TypeText txtYY
            
            '清除剩余所有书签
            On Error Resume Next
            For Each MyBk In wdDoc.Bookmarks
                MyBk.Delete
            Next
            On Error GoTo 0
            
            '将光标定位在页尾
            .EndKey Unit:=6 'wdStory = 6
            '插入分页符
            .InsertBreak Type:=7 'wdPageBreak = 7
            
        '循环下一个单元格
        Next MyCell
            
        '将光标定位在页首
        .HomeKey Unit:=6 'wdStory = 6
    End With

    '激活Word
    wdApp.Activate
    '释放内存
    Set wdDoc = Nothing
    Set wdApp = Nothing
    
    '开启屏幕更新
    Application.ScreenUpdating = True
End Sub

语法参考

Documents.Add 方法
Range.Offset 属性
Document.GoTo 方法
Selection.TypeText 方法
Bookmark.Delete 方法
Selection.EndKey 方法
Selection.InsertBreak 方法
Selection.HomeKey 方法