为什么运行这个宏后没反应呢？目的是邮件合并后，每人一个文件。

zphufo

下面两个宏是从论坛抄来的，去年还能用。今年就不能了。奇怪啊。

目的是邮件合并后，每人一个文件（领导要求的）。

电脑是联想的E40，软件是win7小兵Ghost版，Ms office2007精简版。

文件见下面附件。

－－－－－－－－－－－－－－－－－－－－－
Sub 分页()
'
'主文档的类型为信函
'合并全部数据记录
'假设主文档已链接好数据源，可以进行正常的邮件合并
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 "D:\" & myname & ".doc"  '假设生成的各文档保存于D盘根目录下
                .Close  '关闭生成的文档（已保存）
            End With
        Next
    End If
End With
Application.ScreenUpdating = True
End Sub
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
Sub 邮件合并另存为独立文档()
'
'合并全部数据记录
'假设主文档已链接好数据源，可以进行正常的邮件合并
Dim fso, f1
Dim t As String
t = ActiveDocument.Path
Set fso = CreateObject("scripting.filesystemobject")
If (fso.folderexists(t & "\拆分后文档")) Then
        '如果存在不管他
     Else
       Set f1 = fso.createfolder(t & "\拆分后文档")
     End If
'以上创建文件夹，多谢Mn860429卡卡西

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个字段（合并域）的当前数据字符串，用以命名文件
            myname = "2017年秋季入学学籍表（" & .DataFields(1).Value & ")"
            .ActiveRecord = wdNextRecord
            .Parent.Execute  '每次合并一个数据记录
            With ActiveDocument
                .Content.Characters.Last.Previous.Delete  '删除分节符
              .SaveAs FileName:=t & "\拆分后文档\" & myname & ".doc" '拆分文档命名及存储位置
                .Close  '关闭生成的文档（已保存）
            End With
        Next
    End If
End With
Application.ScreenUpdating = True    '恢复屏幕更新
MsgBox "拆分完成，请到本目录下“拆分后文档”文件夹查看！", 64, "提示"
End Sub
－－－－－－－－－－－－－－－－－－－－－－－－－－
邮件合并分页.rar (30 KB, 下载次数: 12)

2018-6-7 11:26 上传

点击文件名下载附件

zphufo

最后发现上面的宏只能在WORD2003和EXCEL2003下使用。吐血啊。

wdpfox

如何修改为通用的，请高手老师们！

daibao88

建议手工邮件合并，vba分拆word
或者直接vba excel word数据联动生产word单人文档

zphufo

daibao88 发表于 2018-6-8 15:57
建议手工邮件合并，vba分拆word
或者直接vba excel word数据联动生产word单人文档

求具体方法