Run a Mail merge from Excel via button?

[Bee67]

Hi
So I am trying to run a mail merge from a button on a worksheet (called Data) into a Word template populating the template from rows of data on the ‘Data’ sheet. The data starts in row 2 and there can be up to 9999 rows with data in columns A to F.

Plain English steps are when clicking the button:

Open word template (Template.doc).
Check if row 2 on ‘Data’ worksheet is empty (cell A2 blank).
If it is blank put out a message ‘No data to process’ and close word template.
If not blank then insert row 2 data items (cells A2-F2) into template.
Do a ‘Save As’ to save a Word document with file name concatenated from a value in cell A1, todays run date, run time and value in col A (unique identifier) into a file location (say C:word_docs). Example word doc name is ‘Company A_20230227_18:05:17_0001.doc’
Loop back up and repeat for row 3 data.
Loop until col A on the row is blank (ie., hits an empty row).
Close word template.
Put out message ‘Processing complete’.

I haven’t managed to achieve this and what I have so far is very inelegant!

Is this possible to do? Any help really appreciated.

TIA.

 

[sijpie]

Sure is possible. just to check: for each row in column_A a new file is created with just the information of that one row added to it.

Where in the template does this information need to be inserted?

 

[Bee67]

Sure is possible. just to check: for each row in column_A a new file is created with just the information of that one row added to it.

Where in the template does this information need to be inserted?

Hi. Thanks for replying.
Yes each row must create a separate word document.
The template has tags in it. So, for example, row A contains a value called Reference and the Word template has a tag called <Reference> where the value from Column A must be inserted.
TIA

 

[sijpie]

In the template document: I am assuming that you mean 'Merge field' when you mention tag.

 

[Bee67]

In the template document: I am assuming that you mean 'Merge field' when you mention tag.

Yes that’s right - sorry - terminology a bit wrong!

 

[sijpie]

This should do the trick.

On a large number of rows the user will not see anything happening for a while, but the word docs are created and closed.. As long as the user is aware, that is OK

Option Explicit

'Merge table to Word template
Dim vIn As Variant

Sub CreateWordDocsFromTemplate()

    Dim lR As Long, lC As Long, UB2 As Long
    Dim Wordapp As Object, WordDoc As Object
    Dim sDocName As String, sTemplatePath As String, sTemplateName As String, _
        sSlash As String, sOutputPath As String, sNameDateTime As String, _
        sFieldName As String
    Dim i As Integer, iFCnt
    '<<<<<<<<<<<<<<<<<  put the correct paths and template file name in the following lines >>>>>>>>>>>>>
    sTemplatePath = "C:\Users\my\OneDrive\Documents\Temp\MrExcel\"
    sTemplateName = "mergetemplate.docs"
    sOutputPath = "C:\Users\my\OneDrive\Documents\Temp\MrExcel\"
    
    'check paths
    sSlash = IIf(sTemplatePath Like "*\*", "\", "/")
    If Right(sTemplatePath, 1) <> sSlash Then sTemplatePath = sTemplatePath & sSlash
    If Right(sOutputPath, 1) <> sSlash Then sOutputPath = sOutputPath & sSlash
    
    'Load data into array for fast processing
    vIn = Sheets("Data").Range("A1").CurrentRegion
    
    'check if contains data
    If vIn(2, 1) = "" Then Exit Sub
    UB2 = UBound(vIn, 2)
    
    sNameDateTime = vIn(1, 1) & "_" & Format(Now(), "yyyymmdd_hh.mm") & "_"
    Set Wordapp = CreateObject("Word.Application")
    
    Wordapp.Visible = True
'    Set mfMF = WordDoc.MailMergeField
    
    For lR = 2 To UBound(vIn, 1)
        'open the template.doc file
        Set WordDoc = Wordapp.Documents.Open(sTemplatePath & sTemplateName)
        'file name concatenated from a value in cell A1, todays run date, run time and value in col A (unique identifier)
        sDocName = sNameDateTime & vIn(lR, 1)
        WordDoc.SaveAs2 sOutputPath & sDocName
        'check each merge field against the column headers
        iFCnt = WordDoc.Fields.Count
        For lC = 1 To UB2
            sFieldName = "*" & vIn(1, lC) & "*"
            For i = 1 To iFCnt
            Debug.Print WordDoc.Fields(i).code
                If WordDoc.Fields(i).code Like "*MERGEFIELD*" Then 'And
                    If WordDoc.Fields(i).code Like sFieldName Then
                        'merge field found. Insert text from the cell
                        WordDoc.Fields(i).Select
                        Wordapp.Selection.TypeText Text:=CStr(vIn(lR, lC))
                        Exit For
                    End If
                End If
            Next i
        Next lC
        WordDoc.Save
        WordDoc.Close
    Next lR
    
    Wordapp.Quit
    Set WordDoc = Nothing
    Set Wordapp = Nothing
End Sub

 

[Bee67]

This should do the trick.

On a large number of rows the user will not see anything happening for a while, but the word docs are created and closed.. As long as the user is aware, that is OK

Option Explicit

'Merge table to Word template
Dim vIn As Variant

Sub CreateWordDocsFromTemplate()

    Dim lR As Long, lC As Long, UB2 As Long
    Dim Wordapp As Object, WordDoc As Object
    Dim sDocName As String, sTemplatePath As String, sTemplateName As String, _
        sSlash As String, sOutputPath As String, sNameDateTime As String, _
        sFieldName As String
    Dim i As Integer, iFCnt
    '<<<<<<<<<<<<<<<<<  put the correct paths and template file name in the following lines >>>>>>>>>>>>>
    sTemplatePath = "C:\Users\my\OneDrive\Documents\Temp\MrExcel\"
    sTemplateName = "mergetemplate.docs"
    sOutputPath = "C:\Users\my\OneDrive\Documents\Temp\MrExcel\"
   
    'check paths
    sSlash = IIf(sTemplatePath Like "*\*", "\", "/")
    If Right(sTemplatePath, 1) <> sSlash Then sTemplatePath = sTemplatePath & sSlash
    If Right(sOutputPath, 1) <> sSlash Then sOutputPath = sOutputPath & sSlash
   
    'Load data into array for fast processing
    vIn = Sheets("Data").Range("A1").CurrentRegion
   
    'check if contains data
    If vIn(2, 1) = "" Then Exit Sub
    UB2 = UBound(vIn, 2)
   
    sNameDateTime = vIn(1, 1) & "_" & Format(Now(), "yyyymmdd_hh.mm") & "_"
    Set Wordapp = CreateObject("Word.Application")
   
    Wordapp.Visible = True
'    Set mfMF = WordDoc.MailMergeField
   
    For lR = 2 To UBound(vIn, 1)
        'open the template.doc file
        Set WordDoc = Wordapp.Documents.Open(sTemplatePath & sTemplateName)
        'file name concatenated from a value in cell A1, todays run date, run time and value in col A (unique identifier)
        sDocName = sNameDateTime & vIn(lR, 1)
        WordDoc.SaveAs2 sOutputPath & sDocName
        'check each merge field against the column headers
        iFCnt = WordDoc.Fields.Count
        For lC = 1 To UB2
            sFieldName = "*" & vIn(1, lC) & "*"
            For i = 1 To iFCnt
            Debug.Print WordDoc.Fields(i).code
                If WordDoc.Fields(i).code Like "*MERGEFIELD*" Then 'And
                    If WordDoc.Fields(i).code Like sFieldName Then
                        'merge field found. Insert text from the cell
                        WordDoc.Fields(i).Select
                        Wordapp.Selection.TypeText Text:=CStr(vIn(lR, lC))
                        Exit For
                    End If
                End If
            Next i
        Next lC
        WordDoc.Save
        WordDoc.Close
    Next lR
   
    Wordapp.Quit
    Set WordDoc = Nothing
    Set Wordapp = Nothing
End Sub

Thank you so much. I will give this a try and confirm back. Really appreciate it.