合併列印 / 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.
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.
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.
