如何根据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 Dev Center上阅读它，但我没有运气。

有人可以帮忙吗？谢谢。

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”，则单击“编辑单个文档”按钮将拦截合并，并且该过程将自动运行。以这种方式拦截“编辑单个文档”过程的潜在缺点是您不再能够选择在该阶段合并哪些记录。但是，您仍然可以通过“编辑收件人列表”工具获得相同的结果 - 并且可以更好地控制。