将每个页面保存为它自己的文档，标题为数据源中的值

Question

我将文档设置为自动提取邮件合并的数据源。

从那里开始，我想将每一页保存为自己的文档，并将文件名设置为邮件合并值之一。

现在我进行邮件合并，然后转到“完成并合并”，然后转到“编辑单个文档”，然后运行使用全局（普通）宏在中断时保存每个页面，但它保存为第 1 页、第 2 页等

我想省去这一步，只需要打开文档，通过单击“是”从源中提取数据，然后运行那里的宏并将每个邮件合并保存为自己的文档。

如果可以在邮件合并完成后自动运行宏而不需要打开宏 window 来启动宏，则加分。

这是脚本。我想消除必须“完成并合并”“编辑单个文档”的麻烦。

Sub Separate_NEO_Letters()
    'Used to set criteria for moving through the document by section.
    Application.Browser.Target = wdBrowseSection

    'A mailmerge document ends with a section break next page.
    'Subtracting one from the section count stop error message.
    For i = 1 To ((ActiveDocument.Sections.Count) - 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.Add
        Selection.Paste

        'Removes the break that is copied at the end of the section, if any.
        Selection.MoveUp Unit:=wdLine, Count:=1, Extend:=wdExtend
        Selection.Delete Unit:=wdCharacter, Count:=1

        ChangeFileOpenDirectory "S:\IT\NEO\Automation\Generated Letters"
        DocNum = DocNum + 1
        ActiveDocument.SaveAs FileName:="Page" & DocNum & ".doc"
        ActiveDocument.Close
        'Move the selection to the next section in the document
        Application.Browser.Next
    Next i
    ActiveDocument.Close savechanges:=wdDoNotSaveChanges
End Sub

Answer 1

借助 macropod 对示例的评论 link，这就是我想出的。

我将它放在 ThisDocument 中并使用 Document_Open 自动运行并在脚本末尾放置 ActiveDocument.Save / Application.Quit 因此文件将运行然后关闭，因为一旦生成了字母，我实际上不需要对文件做任何事情。

这很好用，特别是因为脚本会检查字段是否为空，因为我有一个 excel 文件，我从中提取了 100 行预填充字段，但如果USERNAME 数据字段已填充。

比我希望完成的还要多，感谢 macropod 以及 http://msofficeforums.com >> https://www.msofficeforums.com/mail-merge/21803-mailmerge-tips-tricks.html

Private Sub Document_Open()
' Sourced from: https://www.msofficeforums.com/mail-merge/21803-mailmerge-tips-tricks.html
Application.ScreenUpdating = False
Dim StrFolder As String, StrName As String, MainDoc As Document, i As Long, j As Long
Const StrNoChr As String = """*./\:?|"
Set MainDoc = ActiveDocument
With MainDoc
  StrFolder = .Path & "\Generated Letters\"
  With .MailMerge
    .Destination = wdSendToNewDocument
    .SuppressBlankLines = True
    On Error Resume Next
    For i = 1 To .DataSource.RecordCount
      With .DataSource
        .FirstRecord = i
        .LastRecord = i
        .ActiveRecord = i
        If Trim(.DataFields("USERNAME")) = "" Then Exit For
        'StrFolder = .DataFields("Folder") & "\"
        StrName = .DataFields("USERNAME")
      End With
      On Error GoTo NextRecord
      .Execute Pause:=False
      For j = 1 To Len(StrNoChr)
        StrName = Replace(StrName, Mid(StrNoChr, j, 1), "_")
      Next
      StrName = Trim(StrName)
      With ActiveDocument
        'Add the name to the footer
        '.Sections(1).Footers(wdHeaderFooterPrimary).Range.InsertBefore StrName
        .SaveAs FileName:=StrFolder & StrName & ".docx", FileFormat:=wdFormatXMLDocument, AddToRecentFiles:=False
        ' and/or:
        '.SaveAs FileName:=StrFolder & StrName & ".pdf", FileFormat:=wdFormatPDF, AddToRecentFiles:=False
        .Close SaveChanges:=False
      End With
NextRecord:
    Next i
  End With
End With
Application.ScreenUpdating = True
 ActiveDocument.Save
 Application.Quit
End Sub

将每个页面保存为它自己的文档，标题为数据源中的值

Save each page as it's own document titled as a value from the data source

merge

vba

ms-word

mailmerge

docx-mailmerge