Skip to content

Instantly share code, notes, and snippets.

Show Gist options
  • Star 4 You must be signed in to star a gist
  • Fork 1 You must be signed in to fork a gist
  • Save oliveratgithub/90b5b6f25f0cd67702dcef53b7e7f152 to your computer and use it in GitHub Desktop.
Save oliveratgithub/90b5b6f25f0cd67702dcef53b7e7f152 to your computer and use it in GitHub Desktop.
VBA macro for Microsoft Word (Mac + Windows) to Mail Merge each record into separate documents. Execute the following VBA Macro on your Office Word Mail Merge template to have Word generate & save every record into a single file. More information: https://swissmacuser.ch/microsoft-word-mail-merge-into-single-documents/
'More information & instructions:
'https://swissmacuser.ch/microsoft-word-mail-merge-into-single-documents/
Option Explicit
Sub MailMergeSaveEachRecordToFile()
'
' Save each single Mail Merge Record into a seperate Document
'
Dim rec, lastRecord As Integer
Dim docNameField, strDocName, savePath As String
' Choose Folder dialog (Mac and Windows)
If System.OperatingSystem Like "*Mac*" Then
savePath = MacScript("(choose folder with prompt ""Select the folder"") as string")
Else 'Windows
savePath = ActiveDocument.Path & "\"
End If
' If a destination folder has been selected
If savePath <> "" Then
' Turn off some visuals to speed things up a bit
Application.ScreenUpdating = False
Application.DisplayAlerts = False
' Find the last record of the Mail Merge data
ActiveDocument.MailMerge.DataSource.ActiveRecord = wdLastRecord
lastRecord = ActiveDocument.MailMerge.DataSource.ActiveRecord
' Ask for user confirmation to start creating the documents
If MsgBox(lastRecord & " documents will be created based on your Mail Merge template.", vbOKCancel) = vbOK Then
' Ask for the name of the Merge Field name to use for the document names
docNameField = InputBox("Which Mergefield [name] should be used for document name?")
' Create document for each Mail Merge record (loop)
For rec = ActiveDocument.MailMerge.DataSource.FirstRecord To lastRecord
ActiveDocument.MailMerge.DataSource.ActiveRecord = rec
' Set document name for current record
If Trim(docNameField) = "" Then
strDocName = "document" & rec & ".docx"
Else
strDocName = ActiveDocument.MailMerge.DataSource.DataFields(docNameField).Value & ".docx"
End If
' Execute Mail Merge action
With ActiveDocument.MailMerge
.Destination = wdSendToNewDocument
.Execute
End With
' Save generated document and close it after saving
ActiveDocument.SaveAs FileName:=savePath & strDocName
ActiveDocument.Close False
ActiveDocument.MailMerge.DataSource.ActiveRecord = wdNextRecord
Next rec
' Re-enable screen visuals
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Else 'if no destination folder was selected
'Re-enable screen visuals
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Exit Sub
End If
End If
End Sub
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment