Created
December 1, 2015 12:29
-
-
Save jangins101/b8932dafa2c4a0325398 to your computer and use it in GitHub Desktop.
This gist is a vba script that can be run on a mail merge document to take each merge and save it as an individual file. Would need to be customized for filename, but for most cases, it should be about 95% of the way there.
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Sub MergeAndSaveIndividually() | |
| ' REF: http://stackoverflow.com/questions/12594828/how-to-split-a-mail-merge-and-save-files-with-a-merge-field-as-the-name | |
| ' Get desired save folder | |
| 'REF: http://www.mrexcel.com/forum/excel-questions/294728-browse-folder-visual-basic-applications.html | |
| Dim fldr As FileDialog | |
| Set fldr = Application.FileDialog(msoFileDialogFolderPicker) | |
| With fldr | |
| .Title = "Select a Folder" | |
| .AllowMultiSelect = False | |
| .InitialFileName = strPath | |
| If .Show <> -1 Then GoTo NextCode | |
| DocPath = .SelectedItems(1) | |
| End With | |
| NextCode: | |
| Set fldr = Nothing | |
| ' Get name format | |
| 'REF: http://www.excel-pratique.com/en/vba/dialog_boxes.php | |
| FileNamePrefix = InputBox("Please enter name prefix", "File name prefix", "MailMerge Prefix") | |
| Dim EmailAddress As String | |
| ' Start the data source over | |
| ActiveDocument.MailMerge.DataSource.ActiveRecord = wdFirstRecord | |
| For i = 1 To ActiveDocument.MailMerge.DataSource.RecordCount | |
| ' Begin the merge process and pause after each merge | |
| With ActiveDocument.MailMerge | |
| .Destination = wdSendToNewDocument | |
| .SuppressBlankLines = True | |
| With .DataSource | |
| .FirstRecord = ActiveDocument.MailMerge.DataSource.ActiveRecord | |
| .LastRecord = ActiveDocument.MailMerge.DataSource.ActiveRecord | |
| ' Grab the email address | |
| EmailAddress = .DataFields("Email_Address").Value | |
| End With | |
| ' Merge the active record | |
| .Execute Pause:=False | |
| End With | |
| ' Save the merged document | |
| FilePath = DocPath + "/" + FileNamePrefix + " (" + EmailAddress + ").docx" | |
| ActiveDocument.SaveAs2 _ | |
| FileName:=FilePath, _ | |
| FileFormat:=wdFormatXMLDocument, _ | |
| LockComments:=False, _ | |
| Password:="", _ | |
| AddToRecentFiles:=True, _ | |
| WritePassword:="", _ | |
| ReadOnlyRecommended:=False, _ | |
| EmbedTrueTypeFonts:=False, _ | |
| SaveNativePictureFormat:=False, _ | |
| SaveFormsData:=False, _ | |
| SaveAsAOCELetter:=False, _ | |
| CompatibilityMode:=14 | |
| ' Close the resulting document | |
| ActiveDocument.Close | |
| ' Now, back in the template document, advance to next record | |
| ActiveDocument.MailMerge.DataSource.ActiveRecord = wdNextRecord | |
| Next i | |
| End Sub |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment