问题
I am using the below Macro to split the mail merged into separate documents. What I need is it to split into separate documents keeping the whole page including the header and footers and saving as in the first merged field on the page, which is the first piece of information on the merged letters.
However, the macro runs only on one letter not the rest, and the format is completely incorrect. It changes the font, page layout and does not include the headers and footers. It also saves as 'Ref' rather than the first merged field on the letter.
Does anyone have any idea how to amend the code below so it correctly updates with the above and for all letters please? I understand if this looks really bad but I am new to VBA and no one on my project to ask for help. Thanks in advance
Sub splitter()
' Based on a macro by Doug Robbins to save each letter created by a mailmerge as a separate file.
' With help from http://www.productivitytalk.com/forums/topic/3927-visual-basic-question-for-merge-fields/
Dim i As Integer
Dim Source As Document
Dim Target As Document
Dim Letter As Range
Dim oField As Field
Dim Ref As String
Set Source = ActiveDocument
For i = 1 To Source.Sections.Count
Set Letter = Source.Sections(i).Range
Letter.End = Letter.End - 1
For Each oField In Letter.Fields
If oField.Type = wdFieldMergeField Then
If InStr(oField.Code.Text, "Ref") > 0 Then
'get the result and store it the Ref variable
Ref = oField.Result
End If
End If
Next oField
Set Target = Documents.Add
Target.Range = Letter
Target.SaveAs FileName:="\\svr4958file01\Libraries\u20480\Documents\On Hold letters Template\20150512 On hold Letters Customers Active and Cancelled\" & "Ref"
Target.Close
Next i
End Sub
回答1:
This is just an answer to the second part:
This line:
If InStr(oField.Code.Text, "Ref") > 0 Then
Is finding the mergefield with "Ref" in it. If you need a different mergefield, you should put the name of the mergefield you wish to save the file as where "Ref" is, so if your mergefield is, "Addressee" then change it to:
If InStr(oField.Code.Text, "Address") > 0 Then
Also, your last line is saving the filename with the STRING "Ref" instead of the variable. You need to remove the quotes around Ref. It should read:
Target.SaveAs FileName:="\\svr4958file01\Libraries\u20480\Documents\On Hold letters Template\20150512 On hold Letters Customers Active and Cancelled\" & Ref
As far as the rest, you could use an alternative approach (I don't really have time to provide code for this right now). Find the first and last page of each range (which is set to variable Letter) and print out these pages to a word doc. This will keep the headers and footers. The code you will need to enter will be:
Letter.Information(wdActiveEndPageNumber)
to get the page number of the end of the range (not sure but I assume (wdActiveStartPageNumber) or something similar will get the first page of the range
and
Application.PrintOut From:=FirstPageNum, To:=LastPageNum, OutputFileName:=:="\\svr4958file01\Libraries\u20480\Documents\On Hold letters Template\20150512 On hold Letters Customers Active and Cancelled\" & Ref & ".doc"
Will update more later if I get the time.
回答2:
Offering an alternative answer to this old question as I recently had to solve it myself, and this question still ranks high up the results when searching for this issue.
I started with the macro at https://word.tips.net/T001538_Merging_to_Individual_Files.html, modifying it to first create separate blank documents based on the mail merge file, to preserve headers, footers and formatting. This may be an inefficient method, but doesn't require messing around with templates.
The following macro should be run from the mail merge output document which needs to be split.
Sub BreakOnSection()
'***Update the working folder location below***
ChangeFileOpenDirectory "C:\C:\Users\User\Downloads"
'***Update the original mail merge file name below***
mailmergeoriginal = "Original Mail merge.docx"
'Makes code faster and reduces screen flicker
Application.ScreenUpdating = False
'Used to set criteria for moving through the document by section.
Application.Browser.Target = wdBrowseSection
SectionCount = ActiveDocument.Sections.Count
'Save a template for each mailmerge document
ActiveDocument.StoryRanges(wdMainTextStory).Delete
DocNum = 1
For i = 1 To (SectionCount - 1)
ActiveDocument.SaveAs FileName:="Mail merge " & DocNum & ".docx"
DocNum = DocNum + 1
Next i
ActiveDocument.SaveAs FileName:="Macro temp.docx"
Documents.Open FileName:= mailmergeoriginal
Documents("Combined Offers.docx").Activate
'A mailmerge document ends with a section break next page
DocNum = 1
For i = 1 To (SectionCount - 1)
'Select and copy the section text to the clipboard
ActiveDocument.Bookmarks("\Section").Range.Copy
'Create a new document to paste text from clipboard
Documents.Open FileName:="Mail merge " & DocNum & ".docx"
'To save your document with the original formatting'
Selection.PasteAndFormat (wdFormatOriginalFormatting)
'Removes any break copied at the end of the section
Selection.MoveUp Unit:=wdLine, Count:=1, Extend:=wdExtend
Selection.Delete Unit:=wdCharacter, Count:=1
ActiveDocument.SaveAs FileName:="Mail merge " & DocNum & ".docx"
ActiveDocument.Close
DocNum = DocNum + 1
'Move the selection to the next section in the document
Application.Browser.Next
Next i
End Sub
Please note that this macro will leave one extra file behind after running, called "Macro temp.docx", which I needed to keep open to keep the macro running. This file can safely be deleted after completion. This could probably be avoided, but I wanted to avoid needing to run the macro from a template and haven't come up with a better method.
来源：https://stackoverflow.com/questions/30240584/ms-word-mail-merge-and-split-documents-saving-header-and-footer-issue