I pieced together this word macro below with the intent on automating the generation of individual reports via mailmerge. The process goes like this:
1. User is prompted to select excel file to use as data source.
2. Data source loads; 'Do While' loop runs.
a. Each mail merge record is saved as a unique word document.
I need to break this do while loop out so that I have code for each record that exists. The reason for this is, from the same file loaded as a data source, I also need to copy tables and graphs from specific spreadsheets and then find specific words in the word document and copy/paste special image replace those words with the specified table/graph.
1. User is prompted to select excel file to use as data source.
2. Data source loads; 'Do While' loop runs.
a. Each mail merge record is saved as a unique word document.
I need to break this do while loop out so that I have code for each record that exists. The reason for this is, from the same file loaded as a data source, I also need to copy tables and graphs from specific spreadsheets and then find specific words in the word document and copy/paste special image replace those words with the specified table/graph.
VBA Code:
Sub MailMergeToPdfBasic()
Application.ScreenUpdating = False
Dim StrMMSrc As String
With Application.FileDialog(FileDialogType:=msoFileDialogFilePicker)
.Title = "Select Excel Data Srouce File"
.AllowMultiSelect = False
.Filters.Add "Documents", "*.xls; *.xlsx; *.xlsm", 1
.InitialFileName = ""
If .Show = -1 Then
StrMMSrc = .SelectedItems(1)
Else
GoTo ErrExit
End If
End With
With ActiveDocument.MailMerge
.OpenDataSource Name:=StrMMSrc, ReadOnly:=True, AddToRecentFiles:=False, _
LinkToSource:=False, Connection:="Provider=Microsoft.ACE.OLEDB.12.0;User ID=Admin;" & _
"Data Source=StrMMSrc;Mode=Read;Extended Properties=""HDR=YES;IMEX=1"";", _
SQLStatement:="SELECT * FROM `MMERGE$`", SQLStatement1:="", SubType:= _
wdMergeSubTypeAccess
End With
ErrExit:
Application.ScreenUpdating = True
'MailMerge to DOC/PDF
Dim masterDoc As Document, singleDoc As Document, lastRecordNum As Integer ' Create variables ("Post-it Notes") for later use
'Dialogs(wdDialogMailMergeRecipients).Display TimeOut:=1
Set masterDoc = ActiveDocument ' Identify the ActiveDocument (foremost doc when Macro run) as "masterDoc"
masterDoc.MailMerge.DataSource.ActiveRecord = wdLastRecord ' jump to the last active record (active = ticked in edit recipients)
lastRecordNum = masterDoc.MailMerge.DataSource.ActiveRecord ' retrieve the record number of the last active record so we know when to stop
masterDoc.MailMerge.DataSource.ActiveRecord = wdFirstRecord ' jump to the first active record (active = ticked in edit recipients)
Do While lastRecordNum > 0 ' create a loop, lastRecordNum is used to end the loop by setting to zero (see below)
masterDoc.MailMerge.Destination = wdSendToNewDocument ' Identify that we are creating a word docx (and no e.g. an email)
masterDoc.MailMerge.DataSource.FirstRecord = masterDoc.MailMerge.DataSource.ActiveRecord ' Limit the selection to just one document by setting the start ...
masterDoc.MailMerge.DataSource.LastRecord = masterDoc.MailMerge.DataSource.ActiveRecord ' ... and end points to the active record
masterDoc.MailMerge.Execute False ' run the MailMerge based on the above settings (i.e. for one record)
Set singleDoc = ActiveDocument ' Identify the ActiveDocument (foremost doc after running the MailMerge) as "singleDoc"
' Save "singleDoc" as a word docx with the details provided in the DocFolderPath and DocFileName fields in the MailMerge data
singleDoc.SaveAs2 _
FileName:=masterDoc.MailMerge.DataSource.DataFields("DocFolderPath").Value & Application.PathSeparator & _
masterDoc.MailMerge.DataSource.DataFields("DocFileName").Value & ".docx", _
FileFormat:=wdFormatXMLDocument
singleDoc.Close False ' Close "singleDoc", the variable "singleDoc" can now be used for the next record when created
If masterDoc.MailMerge.DataSource.ActiveRecord >= lastRecordNum Then ' test if we have just created a document for the last record
lastRecordNum = 0 ' if so we set lastRecordNum to zero to indicate that the loop should end
Else
masterDoc.MailMerge.DataSource.ActiveRecord = wdNextRecord ' otherwise go to the next active record
End If
Loop ' loop back to the Do start
End Sub ' Mark the end of the Subroutine