邮件合并后用以下宏拆分时，页眉错位一位

sio1314

邮件合并，用word读出excel的数列，按道理页眉和正文应该是读的同一行的数据，预览也是对的，
但是只要用了以下代码，页眉总会往后错位一行。正文数据为1 2 3 4，页眉也应该是1 2 3 4，
拆开成单个文件之后会变成 页眉会变成2 3 4 4 ，错一位，最后一行数据会出现两次。
样例.rar (60.29 KB, 下载次数: 5)

2015-12-11 21:05 上传

点击文件名下载附件

1. Sub myMailMerge()
   
2. '主文档的类型为信函
   
3. '合并全部数据记录
   
4. '假设主文档已链接好数据源，可以进行正常的邮件合并
   
5. Dim myMerge As MailMerge, i As Integer, myname As String, t As String
   
6. t = ActiveDocument.Path
   
7. Set fso = CreateObject("scripting.filesystemobject")
   
8.     If (fso.folderexists(t & "\拆分后文档")) Then
   
9.         '如果存在不管他
   
10.      Else
    
11.        Set f1 = fso.createfolder(t & "\拆分后文档")
    
12.      End If
    
13. '以上创建文件夹，多谢Mn860429卡卡西
    
14. Set myMerge = ActiveDocument.MailMerge
    
15. With myMerge.DataSource
    
16.     If .Parent.State = wdMainAndDataSource Then
    
17.         .ActiveRecord = wdFirstRecord
    
18.         For i = 1 To .RecordCount
    
19.             .FirstRecord = i
    
20.             .LastRecord = i
    
21.             .Parent.Destination = wdSendToNewDocument
    
22.             '取得数据源第1个和第2个字段（合并域）的当前数据字符串，用以命名文件
    
23.             myname = .DataFields(2).Value & "(" & .DataFields(1).Value & ")"
    
24.             .ActiveRecord = wdNextRecord
    
25.             .Parent.Execute  '每次合并一个数据记录
    
26.             With ActiveDocument
    
27.                 .Content.Characters.Last.Previous.Delete  '删除分节符
    
28.                 .SaveAs t & "\拆分后文档" & myname '生成的各文档保存目录
    
29.                 .Close  '关闭生成的文档（已保存）
    
30.             End With
    
31.         Next
    
32.     End If
    
33. End With
    
34. Application.ScreenUpdating = True
    
35. MsgBox "拆分操作完毕!" & vbCrLf & "请到本目录下“拆分后文档”文件夹查看！！", vbInformation
    
36. End Sub
    

复制代码