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.
ActiveDocument.Bookmarks("\Page").Range.Copy
'Create a new document to paste text from clipboard.
Documents.Add
Selection.Paste
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
ActiveDocument.Close
' Move the selection to the next section in the document.
Application.Browser.Next
Next I
'Application.Quit SaveChanges:=wdSaveChanges
End
CopyFailed:
'MsgBox ("No final Section Break in " & strBaseFilename)
Application.Quit SaveChanges:=wdSaveChanges
End
End Sub
转载于:https://blog.51cto.com/batter/1353975