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

Hawk11ns

Board Regular
Joined
Jul 21, 2015
Messages
61
Office Version
  1. 365
Platform
  1. Windows
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.

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
 

Excel Facts

What is =ROMAN(40) in Excel?
The Roman numeral for 40 is XL. Bill "MrExcel" Jelen's 40th book was called MrExcel XL.
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.
 
Upvote 0
@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)
 
Upvote 0

Forum statistics

Threads
1,223,950
Messages
6,175,582
Members
452,653
Latest member
craigje92

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top