Export from Access to mulitple Word Merge Letters

G

Guest

Hi,

I am trying to export data from Access to Word using Word Mail Merge. So
far I have been successful exporting an entire query to one document or to
multiple documents with different filenames, but all documents contain all of
the data that I am exporting. This is what I would like it to do:

I have a Supervisor table, an Employee table and a Certification table. I
would like to export to multiple Word documents, each containing
Certification information for only one Supervisor. Once I get this working,
I am going to add additional code to automatically email the documents to the
Supervisors.

I did something similar with Excel and separate tabs, so I tried to use
similar code, but it is not working and I have tried everything I can think
of with no success. I am using a 2nd query containing Supervisors with
Selected_Supervisor() as criteria that should work to filter the information
for each separate merge document and another query to pull the Certification
information.

Any help would be appreciated.

Arlene

Public Sub ExpiredCertifications()
On Error GoTo Err_ExpiredCertifications
Dim rst As DAO.Recordset
Dim objWord As Word.Document
Dim appWord As Word.Application
Set appWord = GetObject(Class:="Word.Application")

strPath = "\\chcwp03fs\fo_common$\Database\Expired Certifications\"
strQuery = "qry_ExpiredCertifications"
strTemplate = "\\chcwp03fs\fo_common$\Database\Templates\Expired
Certifications.doc"
strDataSource =
"\\chcwp03fs\fo_common$\Database\Templates\qry_ExpiredCertifications.txt"
strMergeDoc = " Expired Certifications.doc"

Set rst = CurrentDb.OpenRecordset("qry_ExportSupervisors", dbOpenDynaset)
Do Until rst.EOF
vSupervisor = rst!Supervisor
DoCmd.TransferText acExportMerge, , strQuery, strDataSource
Set objWord = GetObject(strTemplate, "Word.Document")
objWord.Application.Visible = True
objWord.MailMerge.OpenDataSource Name:=strDataSource,
ConfirmConversions:=False, ReadOnly:=False, LinkToSource:=False,
AddToRecentFiles:=False, PasswordDocument:="", PasswordTemplate:="",
WritePasswordDocument:="", WritePasswordTemplate:="", Revert:=False,
Format:=0, Connection:=""
objWord.MailMerge.Execute
objWord.SaveAs strPath & vSupervisor & strMergeDoc
objWord.Close
rst.MoveNext
Loop
rst.Close
Set rst = Nothing
Set objWord = Nothing
appWord.Quit
Set appWord = Nothing
Exit_ExpiredCertifications:
Exit Sub
Err_ExpiredCertifications:
Select Case Err.Number
Case 428 'Automation object doesn't exist
Set appWord = CreateObject(Class:="Word.Application")
Resume Next
Case 429 'Automation object doesn't exist
Set appWord = CreateObject(Class:="Word.Application")
Resume Next
Case 462
Set appWord = CreateObject(Class:="Word.Application")
Resume Next
Case Else 'Unforeseen Errors
MsgBox "Please record this information: " & Err.Description & "
" & Err.Number & " " & Err.Source, vbOKOnly, "Expired Certifications - Word
Merge Letters"
Resume Exit_ExpiredCertifications
End Select
End Sub

Public Function Selected_Supervisor()
Selected_Supervisor = vSupervisor
End Function
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top