MS Word Mail Merge and Split Documents saving, Header and footer issue

问题

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

标签

vba

merge

ms-word

mailmerge