如何根据VBA中的邮件合并属性重命名word文档？

Question

标题可能有点血腥，但我们来了。

目前我有一个 word 文档，它使用邮件合并从 Excel 工作表中插入两个属性（日期和名称）。生成合并后，我就有一个宏将结果文档的每一页拆分为它自己的单独文档。我使用的宏只是从VBA Express here 复制和粘贴的，如下所示。

Sub SplitIntoPages()
    Dim docMultiple As Document
    Dim docSingle As Document
    Dim rngPage As Range
    Dim iCurrentPage As Integer
    Dim iPageCount As Integer
    Dim strNewFileName As String

    Application.ScreenUpdating = False 'Makes the code run faster and reduces screen _
    flicker a bit.
    Set docMultiple = ActiveDocument 'Work on the active document _
    (the one currently containing the Selection)
    Set rngPage = docMultiple.Range 'instantiate the range object
    iCurrentPage = 1
     'get the document's page count
    iPageCount = docMultiple.Content.ComputeStatistics(wdStatisticPages)
    Do Until iCurrentPage > iPageCount
        If iCurrentPage = iPageCount Then
            rngPage.End = ActiveDocument.Range.End 'last page (there won't be a next page)
        Else
             'Find the beginning of the next page
             'Must use the Selection object. The Range.Goto method will not work on a page
            Selection.GoTo wdGoToPage, wdGoToAbsolute, iCurrentPage + 1
             'Set the end of the range to the point between the pages
            rngPage.End = Selection.Start
        End If
        rngPage.Copy 'copy the page into the Windows clipboard
        Set docSingle = Documents.Add 'create a new document
        docSingle.Range.Paste 'paste the clipboard contents to the new document
         'remove any manual page break to prevent a second blank
        docSingle.Range.Find.Execute Findtext:="^m", ReplaceWith:=""
         'build a new sequentially-numbered file name based on the original multi-paged file name and path
        strNewFileName = Replace(docMultiple.FullName, ".doc", "_" & Right$("000" & iCurrentPage, 4) & ".doc")
        docSingle.SaveAs strNewFileName 'save the new single-paged document
        iCurrentPage = iCurrentPage + 1 'move to the next page
        docSingle.Close 'close the new document
        rngPage.Collapse wdCollapseEnd 'go to the next page
    Loop 'go to the top of the do loop
    Application.ScreenUpdating = True 'restore the screen updating

     'Destroy the objects.
    Set docMultiple = Nothing
    Set docSingle = Nothing
    Set rngPage = Nothing
End Sub

但是，邮件合并有超过 90 页，如上面的代码所示，它们都是通过在文件名末尾添加数字来命名的。而不是这个，我想拥有它，以便它从每个页面读取合并的 Date 属性并将其用作文件名。我试过修改代码并在 MS 开发中心阅读它，但我没有运气。

有人可以帮忙吗？谢谢。

Answer 1

更好的方法是从一开始就创建单独的文档。通过将以下宏添加到您的 mailmerge 主文档，您可以为每条记录生成一个输出文件。使用数据源中的“日期”字段作为文件名，将文件保存到与 mailmerge 主文档相同的文件夹中。支持 PDF 和 DOCX 输出格式。请注意，如果您的数据源有重复的日期，则只有最后一个处理的日期会保留。

Sub Merge_To_Individual_Files()
'Merges one record at a time to the folder containing the mailmerge main document.
' Sourced from: http://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
Set MainDoc = ActiveDocument
With MainDoc
  StrFolder = .Path & Application.PathSeparator
  For i = 1 To .MailMerge.DataSource.RecordCount
    With .MailMerge
      .Destination = wdSendToNewDocument
      .SuppressBlankLines = True
      With .DataSource
        .FirstRecord = i
        .LastRecord = i
        .ActiveRecord = i
        If Trim(.DataFields("Date")) = "" Then Exit For
        StrName = Format(.DataFields("Date"), "YYYY-MM-DD")
      End With
      .Execute Pause:=False
      If Err.Number = 5631 Then
        Err.Clear
        GoTo NextRecord
      End If
    End With
    With ActiveDocument
      .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
Application.ScreenUpdating = True
End Sub

注意 1： 上面的代码默认将输出保存到 mailmerge 主文档的文件夹。您可以通过编辑更改目标文件夹：

StrFolder = .Path & Application.PathSeparator

注意 2： 如果您将上述宏重命名为“MailMergeToDoc”，单击“编辑单个文档”按钮将拦截合并，该过程将自动运行。以这种方式拦截“编辑单个文档”过程的潜在缺点是您不再可以在该阶段选择要合并的记录。但是，您仍然可以通过“编辑收件人列表”工具获得相同的结果 - 并且可以更好地控制。