Microsoft Access - How do i mailmerge multiple word templates at the same time?

Asked By Kelly How on 28-Mar-14 06:05 AM
Hi
I have an application that merges 130+ word templates using an Access data source.  Currently i am using the code below to loop through each template and merging it.  This takes a long time to run.  Does anybody know if you can merge all the templates at the same time or some other way of speeding up the process?
Thanks
Kelly

Private Sub mergeit() 'called first

On Error GoTo ErrorHandler
    Dim db As Database
    Dim rst As Recordset
    Dim strSQL As String
    Dim strDocumentName As String
    Dim strMergeDoc As String
    Dim strPrintOrder As String
      
      strSQL = "SELECT * FROM tblDataOutput"
      
      Set db = CurrentDb()
      Set rst = db.OpenRecordset("qryDocumentsToCreate")


    ' get docs to be merged begin loop here
    If Not rst.EOF Then rst.MoveFirst
    Do While Not rst.EOF
      
      strDocumentName = rst!DocumentNo
      strMergeDoc = rst!MergeDoc
 
      Call SetQuery("qryData", strSQL)

      Dim strNewName As String  'name to use when saving the merged document

      strNewName = rst!PrintOrder & strDocumentName

      Call OpenMergedDoc(strDocumentName, strMergeDoc, strSQL, strNewName)
      
      Debug.Print strNewName

    rst.MoveNext
    Loop
      
      rst.Close        'Close what you opened.
      Set rst = Nothing    'Deassign all objects.
      Set db = Nothing
'end loop here

Dim Response As String
''merge to master document
Response = MsgBox("You can now print  your documents", vbOK)
'Call mergeAllDocuments
Me!cmdPrint.Visible = True
Exit Sub
ErrorHandler:
    
    MsgBox "Error #" & Err.Number & " occurred. " & Err.Description, vbOKOnly, "Error"
    Exit Sub
End Sub


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

    Dim strtemplatePath As String
    Dim strDocumentPath As String
    Dim objWord As New Word.Application
    Dim objDoc As Word.Document
    Dim strDirTemplate As String
    Dim strDirDocumentOutput As String
    
    
    strtemplatePath = [Forms]![frmCustomers]![TemplateDirectory]
    strDocumentPath = DLookup("[documentPath]", "tblSetup", "[ID] = 1") & "\" & [Forms]![frmlProjects]![ProjectRef]

    strDirTemplate = strtemplatePath
    strDirDocumentOutput = strDocumentPath
   
    If strMergeDoc = "1" Then
      objWord.Application.Visible = False
      Set objDoc = objWord.Documents.Open(strDirTemplate & "\" & strDocName) '
      
      objDoc.MailMerge.OpenDataSource _
        Name:="y:\Data\Safety Connection Template.mdb", _
        LinkToSource:=True, AddToRecentFiles:=False, _
        Connection:="QUERY qryData", _
        SQLStatement:="SELECT * FROM [qryData]"
      
      objDoc.MailMerge.Destination = wdSendToNewDocument
      objDoc.MailMerge.Execute
      
      objWord.Application.Documents(1).SaveAs (strDirDocumentOutput & "\" & strMergedDocName)
      objWord.Application.Documents(1).Close (False)
      objWord.Application.Documents.Close (False)
      
      'close the merge template without saving
      objWord.Quit False
      Set objWord = Nothing
      Set objDoc = Nothing
    Else
      FileCopy strDirTemplate & "\" & strDocName, strDirDocumentOutput & "\" & strMergedDocName
    End If
     
Exit Sub
WordError:
      MsgBox "Err #" & Err.Number & "  occurred." & Err.Description, vbOKOnly, "Word Error"
      objWord.Quit
End Sub