My steps:
Sub OutDoc()
'
' 1) Merges active record and saves the resulting document named by the datafield
' 2) Closes the resulting document, and advances to the next record in the datasource
'
' Based on code by Søren Francis 6/7-2013 at href="http://stackoverflow.com/questions/12594828/how-to-split-a-mail-merge-and-save-files-with-a-merge-field-as-the-name
Dim DokName As String 'ADDED CODE
Dim strFolder As String
Dim fDone As Boolean
fDone = False
' Set the destination folder
strFolder = "C:\Projects\ForAdam\FinalDocs\"
' Start at the first document
ActiveDocument.MailMerge.DataSource.ActiveRecord = wdFirstRecord
Do
With ActiveDocument.MailMerge
.Destination = wdSendToNewDocument
.SuppressBlankLines = True
With .DataSource
.FirstRecord = ActiveDocument.MailMerge.DataSource.ActiveRecord
.LastRecord = ActiveDocument.MailMerge.DataSource.ActiveRecord
' Set the document name
DokName = .DataFields("ResID").Value & .DataFields("First").Value & "_Contract"
End With
' Merge the active record
.Execute Pause:=False
End With
' Save then resulting document. NOTICE MODIFIED filename
ActiveDocument.SaveAs2 FileName:=strFolder + DokName + ".doc", FileFormat:= _
wdFormatDocument, LockComments:=False, Password:="", AddToRecentFiles _
:=True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts _
:=False, SaveNativePictureFormat:=False, SaveFormsData:=False, _
SaveAsAOCELetter:=False
' Close the resulting document
ActiveWindow.Close
' Now, back in the template document, advance to next record if there is a next record
If ActiveDocument.MailMerge.DataSource.ActiveRecord <> ActiveDocument.MailMerge.DataSource.RecordCount Then
ActiveDocument.MailMerge.DataSource.ActiveRecord = wdNextRecord
Else ' Flag that we are done
fDone = True
End If
Loop Until fDone
End Sub
No comments:
Post a Comment
Thank you for commenting!