使用邮件合并主文档分解独立文档并根据域内容命名

Sub myMailMerge()
'主文档的类型为信函
'合并全部数据记录
'假设主文档已链接好数据源，可以进行正常的邮件合并
Dim myMerge As MailMerge, i As Integer, myname As String
Application.ScreenUpdating = False
Set myMerge = ActiveDocument.MailMerge
With myMerge.DataSource
    If .Parent.State = wdMainAndDataSource Then
        .ActiveRecord = wdFirstRecord
        For i = 1 To .RecordCount
            .FirstRecord = i
            .LastRecord = i
            .Parent.Destination = wdSendToNewDocument
            '取得数据源第1个和第2个字段（合并域）的当前数据字符串，用以命名文件
            myname = .DataFields(1).Value & .DataFields(2).Value
            .ActiveRecord = wdNextRecord
            .Parent.Execute  '每次合并一个数据记录
            With ActiveDocument
                .Content.Characters.Last.Previous.Delete  '删除分节符
                .SaveAs "E:\" & myname & ".doc"  '假设生成的各文档保存于E盘根目录下
                .Close  '关闭生成的文档（已保存）
            End With
        Next
    End If
End With
Application.ScreenUpdating = True

End Sub