Triggering a Word Mail Merge from a button on a form ..

[StuartR]

I am trying to action a mail merge from a button on a form.

I've entered code onto my form as shown below, but it is failing at almost the first hurdle.

I get the error message "Compile Error: Variable not defined" on the line ..

Set qdfNewQueryDef = CurrentDb.QueryDefs(strQueryName)

The Code I have entered is triggered by the On Click code and is shown below ..

Don't know if this is relevant, but when I tried to Set a reference to Microsoft DAO (which is currently unchecked) I get a message stating that this conflicts with an existing module, project, or object library !!!



Any help would be appreciated.

Option Compare Database

  Option Explicit
   
  Private Sub SetQuery(strQueryName As String, strSQL As String)
  On Error GoTo ErrorHandler
   

  'set the query from which the merge document will pull its info

  Dim qdyNewQueryDef As QueryDef
  Set qdfNewQueryDef = CurrentDb.QueryDefs(strQueryName)

  qdfNewQueryDef.SQL = strSQL
  qdfNewQueryDef.Close
  RefreshDatabaseWindow

   
  Exit Sub
   
  ErrorHandler:
  MsgBox "Error #" & Err.Number & " occurred." & Err.Description, vbOKOnly, "Error"
  Exit Sub
   

  End Sub
   
  Private Sub Sub_Reminder_1_Click()
   
  On Error GoTo ErrorHandler
  Dim strSQL As String
   
  strSQL = "SELECT Member_Names.Membership_Number, Member_Names.[Full Name], Member_Names.[Address Line 1], Member_Names.[Address Line 2], Member_Names.Town, Member_Names.Region, Member_Names.Country, Member_Names.[Post Code], Member_Names.Last_Payment, Member_Names.Status, Member_Names.Membership_Class, Member_Names.Salutation, Member_Names.Envelope, Member_Names.Pay_by_SO FROM Member_Names WHERE (((Member_Names.Last_Payment)<#12/31/2016#) AND ((Member_Names.Status)='Current') AND ((Member_Names.Membership_Class)='Ordinary' Or (Member_Names.Membership_Class)='Family (Lead)' Or (Member_Names.Membership_Class)='Senior' Or (Member_Names.Membership_Class)='Associate' Or (Member_Names.Membership_Class)='Corporate'))"
   
  Dim strDocumentName As String 'name of word template document
  strDocumentName = "C:\Users\User5\Documents\LUCS\TestReminder1.docx"
   
  Call SetQuery("Sub_Reminder_Query", strSQL)
   
  Dim strNewName As String
  strNewName = "Reminder Letters " & Format(CStr(Date), "dd MMM yyyy")
   
  Call OpenMergedDoc(strDocumentName, strSQL, strNewName)
   
  Exit Sub
   
  ErrorHandler:
  MsgBox "Error #" & Err.Number & " occurred." & Err.Description, vbOKOnly, "Error"
  Exit Sub
   
  End Sub
   
  'Open Word Document etc

   
  Private Sub OpenMergedDoc(strDocName As String, strSQL As String, strMergedDocName As String)
  On Error GoTo WordError
   

  'Save the merged document to this directory

  Const strDir As String = "C:\Users\User5\Documents\LUCS"
   
  Dim objWord As New Word.Application
  Dim objDoc As Word.Document
  objWord.Application.Visible = True
  Set objDoc = objWord.Documents.Open(strDir & strDocName)
   
  objWord.Application.Visible = True
    

  'release the variables
   
  Set objWord = Nothing
  Set objDoc = Nothing
   
  Exit Sub
   
  WordError:
  MsgBox "Error #" & Err.Number & " occurred." & Err.Description, vbOKOnly, "Word Error"
  objWord.Quit
  Exit Sub
   
  End Sub

[ranman256]

you spelled it wrong:
Dim qdyNewQueryDef As QueryDef
Set qdfNewQueryDef = CurrentDb.QueryDefs(strQueryName)

[StuartR]

Thanks Ranman ~ Silly Me .... However

I've corrected that and it's now opening Word, but nothing else happening...

Can you see other major issues with the code.

Cheers

[aytee111]

Instead of using VBA to open Word, open it manually - put a breakpoint on the open statement to prevent it from happening. At that point open the file, the way the code is written nothing else needs to happen, opening it manually should do what you want.

[davegri]

This code will open Word with the Mail Merge dialog active. You pass it the template (.doc) name and the data file name (.csv)
It uses late binding, which makes it version independent.

'---------------------------------------------------------------------------------------
' Procedure : fcnWordMergeMethod2
' DateTime  : 10/19/2015 15:58
' Author    : davegri
'           : LATE BINDING
' Purpose   : Opens Word in mailmerge mode
'---------------------------------------------------------------------------------------
'Params:
'        strWordTemplate  - full path name of word doc (.doc/.docx)
'        strDataSource    - full path name of the data file (.csv)
'
Function fcnWordMergeMethod2(strWordTemplate As String, strDataSource As String)
    On Error GoTo fcnWordMergeMethod2_Error
    Dim intMsgBox as Integer
    Dim strDocName As String
    Dim wActiveDoc As Object
    Dim appWord As Object
    Dim wDoc As Object
    Const wdDoNotSaveChanges = 0
    Const wdSendToNewDocument = 0
    Const wdDialogMailMerge = 676
    intMsgBox = MsgBox("The next step will open WORD with a mail merge." _
        & vbCrLf & vbCrLf & "The Word template document is:" _
        & vbCrLf & strWordTemplate _
        & vbCrLf & vbCrLf & "The data document just created by ACCESS is:" _
        & vbCrLf & strDataSource, vbOKCancel, "     W O R D   M A I L   M E R G E      ")
    If intMsgBox = vbCancel Then Exit Function


'Open a new merge document based on the selected template:
    Set appWord = GetObject(Class:="Word.Application")
    
'close any existing open documents
    For Each wDoc In appWord.Documents
        'Debug.Print wDoc.Name
        wDoc.Close wdDoNotSaveChanges
    Next wDoc
    
    appWord.Documents.Add strWordTemplate
    appWord.visible = True
    strDocName = appWord.ActiveDocument.Name
    'Debug.Print "Initial doc name: " & strDocName


'Set the merge data source to the csv file just created, and do the merge:
    With appWord
        .Activate       'puts focus on WORD
        .ActiveDocument.MailMerge.OpenDataSource _
           Name:=strDataSource
        .ActiveDocument.MailMerge.Destination = _
           wdSendToNewDocument
        .ActiveDocument.MailMerge.Execute
        .Dialogs(wdDialogMailMerge).Show
'Save the newly created merge document:
       '.ActiveDocument.SaveAs strSaveNamePath
 
'Close the master merge document:
        .Documents(strDocName).Close _
        SaveChanges:=wdDoNotSaveChanges
    End With
    Set wActiveDoc = appWord.ActiveDocument
    'Debug.Print wActiveDoc.Name
fcnWordMergeMethod2_Exit:
    Exit Function
fcnWordMergeMethod2_Error:
    Select Case Err
    Case 429 'Word is not running; open Word with CreateObject:
        Set appWord = CreateObject(Class:="Word.Application")
        Resume Next
    Case 4605, 5132
        Resume Next
    Case 5174
        MsgBox "File " & strWordTemplate & " not found"
    Case Else
        Msgbox Err.Number & ", " & Err.Description & " Procedure fcnWordMergeMethod2" & " of basWordCode"
    End Select
    Resume fcnWordMergeMethod2_Exit
End Function

[StuartR]

Thanks Davgri,

This is probably a silly question, but where you state ... "You pass it the template (.doc) name and the data file name (.csv)"

Where do I put the Template .doc name, and ....
How do I get a csv file from the query that is providing the merge data. (The query has more fields in it than are being used in the merge)
Where do I put the name of the csv file

Cheers

Stuart

[davegri]

Add this code to create the csv file from your query and call the mail merge

Sub subCallMerge_Click()
        Dim strSQL as string
        Dim strDataSrc as String    'gonna create this below from a named query
        Dim strTemplate as String    'must already exist
        strDataSrc =  "C:\Users\User5\Documents\LUCS\TestData.csv"
        strTemplate =  "C:\Users\User5\Documents\LUCS\TestReminder1.docx"
   
       'define your SQL string here for the data file
       strSQL = "Select ......."

        'delete the named query if it already exists
        On Error Resume Next
        DoCmd.DeleteObject acQuery, "qData"
        On Error GoTo 0


       'create the named query
        Call SetQuery("qData", strSQL)       'this sub exists in your code    


        'create the csv from the query
        DoCmd.TransferText acExportDelim, , "qData", strDataSrc, True

         'do the mail merge
        Call fcnWordMergeMethod2(strTemplate, strDataSrc)
end sub

[StuartR]

Davegri,

Back to this after a few days away ...

I think I'm almost there, but when I trigger the code I get an error 3265 ~ Item not found in this collection.

When I click OK a Microsoft Visual Basic Dialog comes up ...

Run-time error 3011 .... The Microsoft Access database engine could not find the object 'qData'

Clicking debug and the error is at the DoCmd.TransferText acExportDelim, , "qData", strDataSrc, True line in the code

Any clues on what I need to do to resolve this ???

Cheers

Stuart

[davegri]

qData is a named query. It's the query that pulls the data for your MM data file.
Replace subCallMerge_Click() with this:

Sub subCallMerge_Click()
         Dim qdf as DAO.QueryDef
        Dim db as DAO.Database
        Dim strSQL as string
        Dim strDataSrc as String    'gonna create this below from a named query
        Dim strTemplate as String    'must already exist
        strDataSrc =  "C:\Users\User5\Documents\LUCS\TestData.csv"
        strTemplate =  "C:\Users\User5\Documents\LUCS\TestReminder1.docx"
   
       'define your SQL string here for the data file
     strSQL = "SELECT Member_Names.Membership_Number, Member_Names.[Full Name], Member_Names.[Address Line 1], Member_Names.[Address Line 2], Member_Names.Town, Member_Names.Region,     Member_Names.Country, Member_Names.[Post Code], Member_Names.Last_Payment, Member_Names.Status, Member_Names.Membership_Class, Member_Names.Salutation, Member_Names.Envelope, Member_Names.Pay_by_SO FROM Member_Names WHERE (((Member_Names.Last_Payment)<#12/31/2016#) AND ((Member_Names.Status)='Current') AND ((Member_Names.Membership_Class)='Ordinary' Or (Member_Names.Membership_Class)='Family (Lead)' Or (Member_Names.Membership_Class)='Senior' Or (Member_Names.Membership_Class)='Associate' Or (Member_Names.Membership_Class)='Corporate'))"

       'set the query from which the merge document will pull its info
    On Error Resume Next
    With db
        .QueryDefs.Delete ("qData")                'Delete the query if it exists
        On Error GoTo 0
        Set qdf = .CreateQueryDef("qData", sSQL)   'Create the query
    End With
    Set qdf = Nothing
    Set db = Nothing

        'create the csv from the query
        DoCmd.TransferText acExportDelim, , "qData", strDataSrc, True

         'do the mail merge
        Call fcnWordMergeMethod2(strTemplate, strDataSrc)
end sub

Query qData should exist after this and you can run it as a test to see what it is selecting.

[StuartR]

Davegri

It is failing at the line ...

Set qdf = .CreateQueryDef("qData", strSQL)   'Create the query

The Error I am getting is RunTime error 91 "Object variable or With block variable not set"

Note that I changed sSQL to strSQL (I presume that is correct, as it didn't like sSQL !!!)

Are we getting close ???

Stuart

[davegri]

Add the red line. Yes, getting close.

Sub subCallMerge_Click()
         Dim qdf as DAO.QueryDef
        Dim db as DAO.Database
        Dim strSQL as string
        Dim strDataSrc as String    'gonna create this below from a named query
        Dim strTemplate as String    'must already exist
        strDataSrc =  "C:\Users\User5\Documents\LUCS\TestData.csv"
        strTemplate =  "C:\Users\User5\Documents\LUCS\TestReminder1.docx"
        Set db = CurrentDB 
       'define your SQL string here for the data file

[StuartR]

SUCCESS ~ Thanks Davegri for all your help and sticking with me on this.

There are numerous other "solutions" offered online that simply don't work ~ Hopefully this thread will help others to achieve.

Thanks again.

Stuart

[davegri]

Glad to help. Good luck with the rest of your project!