Automate Mail Merge from command button

[Rusty]

Hey guys,

I have spent a while surfing around the site for the answer to this problem but to no avail.

I have a form with a command button which when pressed opens a Word Document. It's a mail merge template and I want to be able to automate the actual merge (merge to new a new Word document) as soon as the Word document opens.

Any help with this would be greatly appreciated. I am using the code below and cannot get the objWord.MailMerge.Execute line to work.

Rusty

Private Sub cmdOK_Click()

On Error GoTo Err_cmdOK_Click

' Declare variables
    Dim db As DAO.Database
    Dim qdf As DAO.QueryDef
    Dim varItem As Variant
    Dim strCriteria As String
    Dim strSQL As String
    
    'Dim objWord As Word.Document
    
' Get the database and stored query
    Set db = CurrentDb()
    Set qdf = db.QueryDefs("qryMultiSelect")
' Loop through the selected items in the list box and build a text string
    For Each varItem In Me!lstTrials.ItemsSelected
        strCriteria = strCriteria & ",'" & Me!lstTrials.ItemData(varItem) & "'"
    Next varItem
' Check that user selected something
    If Len(strCriteria) = 0 Then
        MsgBox "You did not select any Trials from the list." _
            , vbExclamation, "Nothing to find"
        Exit Sub
    End If
' Remove the leading comma from the string
    strCriteria = Right(strCriteria, Len(strCriteria) - 1)
' Build the new SQL statement incorporating the string
    strSQL = "SELECT * FROM Trials " & _
             "WHERE Trials.[Name of Trial] IN(" & strCriteria & ");"
' Apply the new SQL statement to the query
    qdf.SQL = strSQL
    
' Open the MailMerge template
    Call Shell("""C:\Program Files\Microsoft Office\Office\WINWORD.EXE"" ""O:\ASWCS\Recruitment data\CTU Cancer Trial Monthly Updates\MonthlyUpdateTemplate.doc""", 1)
    
'objWord.MailMerge.Execute

' Empty the memory
    Set db = Nothing
    Set qdf = Nothing

Exit_cmdOK_Click:
    Exit Sub

Err_cmdOK_Click:
    Resume Exit_cmdOK_Click

End Sub

 

[ansentry]

Try this I got it working in a fashion, it links Ok but I had to finish the merge manually, I am using Office 2003 and I hate the way it merges. Let me know how you go, I may have another solution for you.

Private Sub cmdOK_Click()

On Error GoTo Err_cmdOK_Click

' Declare variables
    Dim db As DAO.Database
    Dim qdf As DAO.QueryDef
    Dim varItem As Variant
    Dim strCriteria As String
    Dim strSQL As String
   [B] Dim objMerge As Word.MailMerge  [/B]  ‘THIS HAS BEEN ADDED
        
' Get the database and stored query
    Set db = CurrentDb()
    Set qdf = db.QueryDefs("qryMultiSelect")
' Loop through the selected items in the list box and build a text string
    For Each varItem In Me!lstTrials.ItemsSelected
        strCriteria = strCriteria & ",'" & Me!lstTrials.ItemData(varItem) & "'"
    Next varItem
' Check that user selected something
    If Len(strCriteria) = 0 Then
        MsgBox "You did not select any Trials from the list." _
            , vbExclamation, "Nothing to find"
        Exit Sub
    End If
' Remove the leading comma from the string
    strCriteria = Right(strCriteria, Len(strCriteria) - 1)
' Build the new SQL statement incorporating the string
    strSQL = "SELECT * FROM Trials " & _
             "WHERE Trials.[Name of Trial] IN(" & strCriteria & ");"
' Apply the new SQL statement to the query
    qdf.SQL = strSQL
    
' Open the MailMerge template
    Call Shell("""C:\Program Files\Microsoft Office\Office\WINWORD.EXE"" ""O:\ASWCS\Recruitment data\CTU Cancer Trial Monthly Updates\MonthlyUpdateTemplate.doc""", 1)
    
[B]objMerge.Execute[/B] ‘THIS HAS BEEN ADDED


' Empty the memory
    Set db = Nothing
    Set qdf = Nothing

Exit_cmdOK_Click:
    Exit Sub

Err_cmdOK_Click:
    Resume Exit_cmdOK_Click

End Sub

 

[Rusty]

Hey John,

No luck with that one I'm afraid. It highlights the Dim objMerge As Word.MailMerge line and states Compile Error: Sub or Function not defined

I'm using Office2000 - does this create a problem?

Cheers,

Rusty

 

[ansentry]

In your References you should have:Microsoft Word 9.00 Object Library

If you don't know where they are open your code window and then Tools / References , locate Microsoft Word 9.00 Object Library and tick it then close down the code window and now try running the code.

 

[Rusty]

John,

Thanks for that - I loaded in the Word Object Library and all appears to be working. It links ok but I had to finish the merge manually - any ideas on automating the last bit?

If not I'll simply educate the users on how to do it manually. (That's no mean feat I can tell you!)

Cheers,

Rusty

 

[Rusty]

Got it!! I was going about the whole thing ass backwards and in the end I wrote some VBA in Word to get it to do it from that end. Works a treat!

Easy when you know how eh?

Thanks for all your help John.

Rusty

Private Sub Document_Open()
'This runs the Mail Merge
    With ActiveDocument.MailMerge
        .Destination = wdSendToNewDocument
        .MailAsAttachment = False
        .MailAddressFieldName = ""
        .MailSubject = ""
        .SuppressBlankLines = True
        With .DataSource
            .FirstRecord = wdDefaultFirstRecord
            .LastRecord = wdDefaultLastRecord
        End With
        .Execute Pause:=True
    End With
End Sub

 

[ansentry]

I have taken a little bit out of your code (can't see why it would be necessary)

Private Sub Document_Open()
'This runs the Mail Merge
    With ActiveDocument.MailMerge
        .Destination = wdSendToNewDocument
        .MailAsAttachment = False
        .MailAddressFieldName = ""
        .MailSubject = ""
        .SuppressBlankLines = True
        With .DataSource
            .FirstRecord = wdDefaultFirstRecord
            .LastRecord = wdDefaultLastRecord
         
        End With
        
       .Execute Pause:=True
                
   End With
   
End Sub

I think this (your method of executing from word) works better, but I would like to (a) remove the sql warning and close the source document , so that on ly the "Letters1" needs to be saved & or Printed.

 

[Rusty]

Yeah the sql warning is a pain in the backside - my version of Word 2000 doesn't display it whereas on another user's PC with 2000 and another with 2003 it does. I'll look for any differences in the settings and let you know.

To switch back to the template document and to close it use the code below (new lines are coloured blue). However it still brings up the standard dialogue box "Do you wish to save the changes you made". If the user clicks "Cancel" it all goes wrong so be sure to use the error handling lines in the code below too and it should work without a hitch.

Hope that helps mate.

Rusty

Private Sub Document_Open()
[COLOR=Navy]On Error GoTo Err_Document_Open[/COLOR]
    With ActiveDocument.MailMerge
        .Destination = wdSendToNewDocument
        .MailAsAttachment = False
        .MailAddressFieldName = ""
        .MailSubject = ""
        .SuppressBlankLines = True
        With .DataSource
            .FirstRecord = wdDefaultFirstRecord
            .LastRecord = wdDefaultLastRecord
        End With
        .Execute Pause:=True
    End With
    [COLOR=Navy]'The line below switches Word back to the original template doc
    Windows("WordDocumentName.doc").Activate
    'If the Word doc has special features like READ ONLY you'll need to use 
    'the line below instead
    'Windows("WordDocumentName.doc [B](Read-Only)[/B]").Activate
    ActiveDocument.Close[/COLOR]

[COLOR=Navy]Exit_Document_Open:
    Exit Sub

Err_Document_Open:
    Resume Exit_Document_Open[/COLOR]

End Sub

 

[Rusty]

Got it!!

To close the source document without saving use the code on the previous posting and change the line "ActiveDocument.Close" to:

ActiveDocument.Close wdDoNotSaveChanges

That should do the trick!

As for the pesky sql message - I'm still working on that.

Rusty

 

[ansentry]

Rusty,

Thank your for the ActiveDocument.Close wdDoNotSaveChanges etc worked like a charm.

To my form that has the list box and code I have added a combo box so that I can select a document to merge the selections from the list box with.

I made a table with 4 fields docMergeID (PK AN) docName docPath docExt (Extension). I then based this combo box on a query and in that query I have combined them to make Full: [DocPath] & "\" & [DocName] & [DocExt] and this become the column(4) in my combo.'

Below is the copy of my code behind the merge button on my form.

Private Sub cmdMerge_Click()
On Error GoTo Err_cmdMerge_Click

' Declare variables
    Dim db As DAO.Database
    Dim qdf As DAO.QueryDef
    Dim varItem As Variant
    Dim strCriteria As String
    Dim strSQL As String
   [B] Dim strMergeDoc As String[/B]
    
    [B]If IsNull(Me.cboMergeChoice) Then
    MsgBox "You have not selected a Document from the list." _
            , vbExclamation, "No Document"
        Me.cboMergeChoice.SetFocus
       
Else
    
  ' Variable choice from combo box cboMergeChoice. StrMergeDoc used in Shell (see below)
 strMergeDoc = Me.cboMergeChoice.Column(4)
     [/B]
   
 
' Get the database and stored query
    Set db = CurrentDb()
    Set qdf = db.QueryDefs("qryMultiSelect")
' Loop through the selected items in the list box and build a text string
    For Each varItem In Me!lstCustomers.ItemsSelected
        strCriteria = strCriteria & ",'" & Me!lstCustomers.ItemData(varItem) & "'"
    Next varItem
' Check that user selected something
    If Len(strCriteria) = 0 Then
        MsgBox "You did not select any Customers from the list." _
            , vbExclamation, "Nothing to find"
        Exit Sub
    End If
' Remove the leading comma from the string
    strCriteria = Right(strCriteria, Len(strCriteria) - 1)
' Build the new SQL statement incorporating the string
    strSQL = "SELECT * FROM QryCusGeneric " & _
             "WHERE QryCusGeneric.[CusDetails] IN(" & strCriteria & ");"
' Apply the new SQL statement to the query
    qdf.SQL = strSQL
    
  [B]  'This runs winword.exe & open the docment list in the variable strMergeDoc
    
   Call Shell("winword -o " & """" & strMergeDoc & """", 1)[/B]
  
 ' Empty the memory
    Set db = Nothing
    Set qdf = Nothing
    
[B]'clears the list box.
    With lstCustomers

        For Each varItem In .ItemsSelected
            .Selected(varItem) = False
        Next varItem
    End With
    
 End If[/B]
    
Exit_cmdMerge_Click:
   Exit Sub

Err_cmdMerge_Click:
  Resume Exit_cmdMerge_Click

Thanks again for all your help.

PS Rusty if you want to send me a PM with your e-mail address I will send you a sample db that is along these lines with a lot more functions. This one runs ALL from Access.

 

[cikwan82]

ansentry,
Can u upload that form, i also have same problem.
Thank you

 

[ansentry]

cikwan82,

That post of mine is over 8 years old, I make no promises but will try and see if I can find a sample to send you.