word邮件合并自动拆分

Sub autosplit()

For i = 1 To 11     'i是拆分成的文件个数
    With ActiveDocument.MailMerge
        .Destination = wdSendToNewDocument
        .SuppressBlankLines = True
        With .DataSource
            .FirstRecord = 1 + (i - 1) * 2000
            .LastRecord = i * 2000
        End With
        .Execute Pause:=False
    End With
    ActiveDocument.SaveAs FileName:="c:/jjh_new" & i & ".doc"
    ActiveDocument.Close
     Windows("jjh.doc").Activate
Next i
   
End Sub