How can I break this 'Do While' loop up and add logic to copy specific tables from a user-selected spreadsheet?

[Hawk11ns]

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.

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

 

[Macropod]

You don't need to break out of the loop. Rather, you need to insert the code that edits 'singleDoc' into the loop before saving that document.

 

[Hawk11ns]

@Macropod does this solution still hold if the tables and graphs are unique to each report? For example, they have different locations and table/graph names. Because of this, I feel like it would be best to have the code written such that it manually cycles through each mailmerge to pdf document and I can then insert the unique table/graph code/references for each one, but also have the code skip if the mailmerge record being reference is not found (instead of erroring out)

 

[Macropod]

Coded properly, yes.