Run Mailmerge from Excel

LadyTiara

New Member
Joined
Feb 20, 2018
Messages
11
Hi. For some reason, there is no Post New Forum button even if I am logged in, so I used this thread to ask a question.
I have excel data with RESULT Tab to create a mail merge with output as individual Word template using a filename that is under column BO by just clicking a button I named 'AutoProduce'.
And this goes in loop.
It almost worked, but there were 2 problems. 1. Files produced were same data as per row 1. 2. Also, say, I have 4 records, one of the 4 records was named differently. Pls help me correct my code.

Code:
Private Sub CommandButton3_Click()
' merge1record_at_a_time Macro


Dim i As String


i = 1




  
Do While Worksheets("RESULT").Range("BQ2").Value <> ""


 
 Dim templateType As String




    
    templateType = Worksheets("RESULT").Range("AW1").Offset(i).Value
  


    


Dim wdApp As Word.Application
Dim wdDoc As Word.Document


On Error Resume Next
Set wdApp = GetObject(, "Word.Application")
If Err.Number <> 0 Then 'Word isn't already running
Set wdApp = CreateObject("Word.Application")
End If
On Error GoTo 0






'Set specific path to get Confo Template
wdApp.Visible = True






'determine which template to use
If templateType = "dog" Then
            Set wdDoc = wdApp.Documents.Open(FileName:="C:\animal Templates\dog.docx")


    
Else
    
            Set wdDoc = wdApp.Documents.Open(FileName:="C:\animal Templates\cat.docx")
        
End If




'rem to change path
wdDoc.MailMerge.OpenDataSource Name:="C:\Macro\Animal Creation.xlsm" _
, ConfirmConversions:=False, ReadOnly:=False, LinkToSource:=True, AddToRecentFiles:=False, _
PasswordDocument:="", WritePasswordDocument:="", _
WritePasswordTemplate:="", Revert:=False, Format:=wdOpenFormatAuto, _
Connection:="Provider=Microsoft.ACE.OLEDB.12.0;Source=C:\Macro\Animal Creation.xlsm;Mode=Read;Extended Properties=""HDR=YES;IMEX=1;"";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Engine Ty", _
SQLStatement:="SELECT * FROM `RESULT$`", SQLStatement1:=""












       With wdDoc.MailMerge
        .Destination = wdSendToNewDocument
        .SuppressBlankLines = True
        With .DataSource
            .FirstRecord = wdDefaultFirstRecord
            .LastRecord = wdDefaultLastRecord
        End With
        .Execute Pause:=False
    End With
    
      
      Dim DocName As String
      DocName = Worksheets("RESULT").Range("BO1").Offset(i).Value








    'Save the confirmation
    'Remember to change Path
    ChangeFileOpenDirectory "C:\Saved Templates"
    ActiveDocument.SaveAs2 FileName:=DocName + ".docx", FileFormat:=wdFormatXMLDocument, LockComments:=False, Password:="", AddToRecentFiles:=True, ReadOnlyRecommended:=True, EmbedTrueTypeFonts _
        :=False, SaveNativePictureFormat:=False, SaveFormsData:=False, _
        SaveAsAOCELetter:=False


    'Close it
   wdDoc.Close False


 i = i + 1
 
Loop
  
     wdApp.Quit
    
 


MsgBox "All done.", vbInformation, "Auto-production completed."
    
End Sub

Thank you!
 
Last edited by a moderator:

Excel Facts

Which Excel functions can ignore hidden rows?
The SUBTOTAL and AGGREGATE functions ignore hidden rows. AGGREGATE can also exclude error cells and more.
Thanks for your reply sir!! However I only have limited vba macro knowledge and I really wanted to fix this issue. I tried to understand it but could not really absorb it much.

If it would not be too mucb of a hassle for you to kindly correct my existing codes. The desired outout was as stated as from my original message.

Thank you very much in advance!
 
Upvote 0
There are some significant issues with your code. For starters, you have:
Do While Worksheets("RESULT").Range("BQ2").Value <> ""
which means the code either doesn't run at all or it runs as an endless loop because nothing else in your code changes that cell's value. Presumably, you should have something like:
Do While Worksheets("RESULT").Range("BQ2").Offset(i).Value <> ""

Moreover, your loop tries to test whether Word is running on each loop or create a new Word session, which is quite unnecessary. It also leaves all the Word documents it creates open until you quit Word.

Try something like:
Code:
Private Sub CommandButton3_Click()
Dim i As Long, StrType As String, StrNm As String
Dim wdApp As New Word.Application, wdDoc As Word.Document
Const StrMMSrc As String = "C:\Macro\Animal Creation.xlsm"
wdApp.DisplayAlerts = wdAlertsNone: wdApp.Visible = True
i = 1
With Worksheets("RESULT")
  Do While .Range("BQ2").Offset(RowOffset:=i).Value <> ""
    StrType = .Range("AW1").Offset(RowOffset:=i).Value
    StrNm = .Range("BO1").Offset(RowOffset:=i).Value
    'determine which template to use
    If StrType = "dog" Then
      Set wdDoc = wdApp.Documents.Open(Filename:="C:\animal Templates\dog.docx")
    Else
      Set wdDoc = wdApp.Documents.Open(Filename:="C:\animal Templates\cat.docx")
    End If
    With wdDoc
      With .MailMerge
        .OpenDataSource Name:=StrMMSrc, ReadOnly:=True, AddToRecentFiles:=False, _
          Connection:="Provider=Microsoft.ACE.OLEDB.12.0;User ID=Admin;" & _
          "Data Source=StrMMSrc;Mode=Read;Extended Properties=""HDR=YES;IMEX=1"";", _
          LinkToSource:=False, SQLStatement:="SELECT * FROM `Sheet1$`"
        .Destination = wdSendToNewDocument
        .SuppressBlankLines = True
        With .DataSource
          .FirstRecord = wdDefaultFirstRecord
          .LastRecord = wdDefaultLastRecord
        End With
        .Execute Pause:=False
      End With
      'Save the confirmation
      With ActiveDocument
        .SaveAs2 Filename:="C:\Saved Templates\" & StrNm & ".docx", _
          FileFormat:=wdFormatXMLDocument, AddToRecentFiles:=True, ReadOnlyRecommended:=True
        'Close it
        .Close False
      End With
      'Close it
      .Close False
    End With
    i = i + 1
  Loop
End With
wdApp.DisplayAlerts = wdAlertsAll: wdApp.Quit: Set wdDoc = Nothing: Set wdApp = Nothing
MsgBox "All done.", vbInformation, "Auto-production completed."
End Sub
 
Upvote 0
With your code, does that mean once it autoproduces, the word will automatically close? I actually want it this way- once i click button on excel, it will open selected template Word App, auto produces data, then close Word App then repeat steps (loop) til it hits the last record.

By the way, thanks for this. Im excited to test your code provided!
 
Upvote 0
Also , I noticed there is Sheet1. I dont have Sheet 1 in my excel file. Shall I need to change it to 'RESULT$' ?

SQLStatement:="SELECT * FROM `Sheet1$`
 
Upvote 0
Oops, you'll need to change:
Sheet1
to:
RESULT
but don't change the ` characters!

And yes, Word will close once the processing is done.
 
Upvote 0
Oops, you'll need to change:
Sheet1
to:
RESULT
but don't change the ` characters!

And yes, Word will close once the processing is done.


Hi Macropod,

I tested it. But there are some inconsistencies.
1. In my RESULT tab, I have 4 records, it auto produced only 3 individual files. Looks like it is the last record that was not captured.
2. In relation to item 1, all of the 4 records including even the blank or 0 records in the rows were captured and combined into one individual file. So does the remaining 2 files. How can we break them, only mail merging in one specific individual file per record? And also how to not capture blank or 0 records. Coz they are currently included as per this provided code.

Thank you very much, Sir!
 
Upvote 0
Most likely your starting cell reference is wrong; instead of "BQ2" you should have "BQ1".

For the second problem, change:

.FirstRecord = wdDefaultFirstRecord
.LastRecord = wdDefaultLastRecord

to:

.FirstRecord = i
.ActiveRecord = i
.LastRecord = i

You'll need to be clearer about what you mean by 'blank or 0 records'. If they exist, that's because of how your data have been constructed. To eliminate them would require knowing what Excel columns determine whether it's one of your 'blank or 0 records' and adding either: a mailmerge filter to exclude those records; or an IF test to the macro to skip those records.
 
Upvote 0

Forum statistics

Threads
1,213,483
Messages
6,113,919
Members
448,533
Latest member
thietbibeboiwasaco

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