0

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

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

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

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

如果可以在邮件合并完成后自动运行宏并且不必打开宏窗口来启动宏，则可以加分。

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

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
4

1 回答 1

0

在macropod的示例链接的帮助下，这就是我想出的。

我将它放在 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
于 2020-11-23T14:50:29.797 回答