搜尋此網誌

2020年4月29日 星期三

合併列印記事:要將合併列印後的每一份文件分開各別存成PDF & .docx,filename還要依每分文件不同而命名

參考資料

合併列印 / Word VBA 自動分頁

How to split a mail merge and save files with a merge field as the name



以下方式還沒測試過,不過紀錄先。

Send Mailmerge Output to Individual Files
By adding the following macro to your mailmerge main document, you can generate one output file per record. Files are saved to the same folder as the mailmerge main document, using the 'Last_Name' & 'First_Name' fields in the data source for the filenames (change these to suit your requirements). PDF & DOCX formats are catered for.

Code:
Sub Merge_To_Individual_Files()
' 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 & "\"
  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("Last_Name")) = "" Then Exit For
        'StrFolder = .DataFields("Folder") & "\"
        StrName = .DataFields("Last_Name") & "_" & .DataFields("First_Name")
      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:
      If Err.Num = 5631 Then Err.Clear
    Next i
  End With
End With
Application.ScreenUpdating = True
End Sub

Note 1: The above code defaults to saving the output to the mailmerge main document's folder. You can change the destination folder by editing:
StrFolder = .Path & ""
If destination folders are specified in the data source, you could delete or comment-out that line and un-comment the line:
'StrFolder = .DataFields("Folder") & ""
where the folder the output is to be saved to is in a data field named 'Folder'. Alternatively, to save the output to the same folder as the data source, you could replace:
StrFolder = .Path & ""
with:
StrFolder = .MailMerge.DataSource.Name
i = InStrRev(StrFolder, "")
StrFolder = Left(StrFolder, i)

Illegal filename characters (i.e. "*./\:?|) are replaced with underscores.

Note 2: If you're using Word 2007 or later, your mailmerge main document will need to be saved in the .doc or .docm formats, as documents using the .docx format cannot contain macros.

Note 3: If you rename the above macro as 'MailMergeToDoc', clicking on the 'Edit Individual Documents' button will intercept the merge and the process will run automatically. The potential disadvantage of intercepting the 'Edit Individual Documents' process this way is that you no longer get to choose which records to merge at that stage. However, you can still achieve the same outcome - and with greater control - via the 'Edit Recipient List' tools.

Note 4: The above code also provides for the filename to be output to the page footer. This, of course, assumes the footer is suitably formatted. Simply uncomment the line concerned.


沒有留言:

張貼留言