MS Word 邮件合并和拆分文档保存、页眉和页脚问题

Question

我正在使用下面的宏来拆分合并到单独文档中的邮件。我需要的是将它分成单独的文档，保留整个页面，包括页眉和页脚，并保存为页面上的第一个合并字段，这是合并字母的第一条信息。

但是，宏只对一个字母运行，对其余字母不运行，而且格式完全不正确。它更改字体、页面布局并且不包括页眉和页脚。它还保存为 'Ref' 而不是信件上的第一个合并字段。

有谁知道如何修改下面的代码，以便它正确地更新上面的所有字母吗？我知道这看起来是否真的很糟糕，但我是 VBA 的新手，我的项目中没有人寻求帮助。提前致谢

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 Template150512 On hold Letters Customers Active and Cancelled\" & "Ref"  
Target.Close
Next i
End Sub

Answer 1

这只是对第二部分的回答：

这一行：

If InStr(oField.Code.Text, "Ref") > 0 Then

正在查找其中包含 "Ref" 的合并域。如果您需要一个不同的合并字段，您应该将您希望保存文件的合并字段的名称放在 "Ref" 所在的位置，因此如果您的合并字段是 "Addressee"，则将其更改为：

If InStr(oField.Code.Text, "Address") > 0 Then

此外，您的最后一行是使用字符串 "Ref" 而不是变量来保存文件名。您需要删除 Ref. 周围的引号。它应该是：

Target.SaveAs FileName:="\svr4958file01\Libraries\u20480\Documents\On Hold letters Template150512 On hold Letters Customers Active and Cancelled\" & Ref

至于其余部分，您可以使用替代方法（我现在真的没有时间为此提供代码）。找到每个范围的第一页和最后一页（设置为变量 Letter）并将这些页面打印到 word 文档中。这将保留页眉和页脚。您需要输入的代码是：

Letter.Information(wdActiveEndPageNumber)

获取范围末尾的页码（不确定但我假设 (wdActiveStartPageNumber) 或类似的东西将获取范围的第一页

和

Application.PrintOut From:=FirstPageNum, To:=LastPageNum, OutputFileName:=:="\svr4958file01\Libraries\u20480\Documents\On Hold letters Template150512 On hold Letters Customers Active and Cancelled\" & Ref & ".doc"

以后有空再更新。

Answer 2

为这个老问题提供一个替代答案，因为我最近不得不自己解决它，而且这个问题在搜索这个问题时仍然排在结果的前列。

我从 https://word.tips.net/T001538_Merging_to_Individual_Files.html 的宏开始，修改它以首先根据邮件合并文件创建单独的空白文档，以保留页眉、页脚和格式。这可能是一种低效的方法，但不需要乱用模板。

下面的宏应该运行来自需要拆分的邮件合并输出文档。

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

请注意，此宏将在运行ning 之后留下一个额外的文件，称为 "Macro temp.docx"，我需要保持打开以保留宏运行ning。完成后可以安全地删除此文件。这可能是可以避免的，但我想避免需要运行来自模板的宏并且还没有想出更好的方法。

MS Word 邮件合并和拆分文档保存、页眉和页脚问题

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

merge

vba

ms-word

mailmerge