Run Mailmerge from Excel

[LadyTiara]

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.

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!

 

[Macropod]

1. To start a new thread, see: https://www.mrexcel.com/forum/faq.php?faq=mrexcel_faq#faq_howtopost

2. When posting code, please use the code tags, indicated by the # button on the posting menu. Without them, your code loses much of whatever structure it had.

3. To automate a mailmerge from Excel, see: https://www.mrexcel.com/forum/gener...vidual-pdf-files-post4796480.html#post4796480

 

[LadyTiara]

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!

 

[Macropod]

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:

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

 

[LadyTiara]

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!

 

[LadyTiara]

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$`

 

[Macropod]

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.

 

[LadyTiara]

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!

 

[Macropod]

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.

 

[LadyTiara]

Sit,

It worked wonders!! MANY THANK YOU FOR YOUR HELP AND FOR THIS EXCEL FORUM!!

Have a nice evening!