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