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