Word中Mail Merge功能之后,分别保存成独立的word文件

Sub BreakOnSection()

Dim a As Excel.Application, ab As Excel.Workbook

Set a = CreateObject("excel.application")

Set ab = a.Workbooks.Open("D:\Book2.xlsx")

  Application.ScreenUpdating = False 'Makes the code run faster and reduces screen flicker a bit.

  ' Used to set criteria for moving through the document by section.

  Application.Browser.Target = wdBrowseSection

  strBaseFilename = ActiveDocument.Name

  On Error GoTo CopyFailed

  'A mail merge document ends with a section break next page.

  For I = 1 To ActiveDocument.Sections.Count

       'Select and copy the section text to the clipboard.


       'Create a new document to paste text from clipboard.



       DocNum = DocNum + 1

       With ab

           empId = .Sheets(1).Range("a" & DocNum + 1)

           pwd = .Sheets(1).Range("c" & DocNum + 1)

       End With

           strNewFileName = "Salary" & empId

           ActiveDocument.SaveAs "D:\" & strNewFileName, Password:=CStr(pwd), WritePassword:="admin112233", ReadOnlyRecommended:=True


           ' Move the selection to the next section in the document.


       Next I

           'Application.Quit SaveChanges:=wdSaveChanges



   'MsgBox ("No final Section Break in " & strBaseFilename)

   Application.Quit SaveChanges:=wdSaveChanges


End Sub