Access to word mail merge

[danian]

Guys,

I recently had a developer create me an acccess database for my plumbing business. It basically looks at contacts that i have with clients. On a monthly basis i run a form that looks at all my clients contracts that are ending in that month (I choose from a lstbox). It then runs the following query:

Option Compare Database
Option Explicit

Dim WithEvents oApp As Word.Application

Const REPORT_DIR            As String = "C:\Templates" '"D:\My Documents\Heatcover\Templates"
Const REPORT_TEMPLATE       As String = "Service_Plan_Renewal_Notice.dot"
Const REPORT_FILE_PREFIX    As String = "Renewal Notice "
Const REPORT_QRY            As String = "qryClientRenewal"

Private sMonth              As String
Private sYear               As String

Private Sub SetQuery(ByRef sQueryName As String, ByRef sSQL As String)
    On Error GoTo ErrorHandler
    
        'set the query from which the merge
        'document will pull its info
    Dim qdfNewQueryDef      As QueryDef
    
    Set qdfNewQueryDef = CurrentDb.QueryDefs(sQueryName)
        qdfNewQueryDef.SQL = sSQL
        qdfNewQueryDef.Close
        
        Call InsertHistoryData
        Call RefreshDatabaseWindow
        
GoTo ExitProcedure
ErrorHandler:
    MsgBox "Error #" & Err.Number & " occurred. " & Err.Description, vbOKOnly, "Error"
ExitProcedure:
End Sub



Public Sub BuildQuery()
    'creates an SQL statement to be used in the query def
    On Error GoTo ErrorHandler
    
    Dim sSQL            As String
    
    sSQL = "SELECT  tblClients.Mem_No AS Mem_No, "
    sSQL = sSQL & "  tblClients.Title AS Title, "
    sSQL = sSQL & "  tblClients.Name AS Name, "
    sSQL = sSQL & "  tblClients.Account_address AS Account_address, "
    sSQL = sSQL & "  tblClients.Account_town AS Account_town, "
    sSQL = sSQL & "  tblClients.Account_county AS Account_county, "
    sSQL = sSQL & "  tblClients.Account_postcode AS Account_postcode, "
    sSQL = sSQL & "  tblClients.Installation_address AS Installation_address, "
    sSQL = sSQL & "  tblClients.Installation_town AS Installation_town, "
    sSQL = sSQL & "  tblClients.Installation_county AS Installation_county, "
    sSQL = sSQL & "  tblClients.Installation_postcode AS Installation_postcode, "
    sSQL = sSQL & "  tblContracts.Type_of_Cover AS Type_of_Cover, "
    sSQL = sSQL & "  tblContracts.End_Contract AS End_Contract, "
    sSQL = sSQL & "  tblContracts.ID AS ContractID, "
    sSQL = sSQL & "  tblTypeofCover.Cost AS Payment"
    sSQL = sSQL & " FROM  (tblClients "
    sSQL = sSQL & " INNER JOIN tblContracts "
    sSQL = sSQL & " ON tblClients.ID = tblContracts.ClientID)"
    sSQL = sSQL & " INNER JOIN tblTypeofCover ON tblContracts.Type_of_Cover = tblTypeofCover.Type_of_Cover"
    sSQL = sSQL & " WHERE MONTH(tblContracts.End_Contract) = " & sMonth & ""
    sSQL = sSQL & " AND  YEAR(tblContracts.End_Contract) = " & sYear & ";"
    
    Call SetQuery(REPORT_QRY, sSQL)
    
GoTo ExitProcedure
ErrorHandler:
    MsgBox "Error #" & Err.Number & " occurred. " & Err.Description, vbOKOnly, "Error"
    
ExitProcedure:
End Sub


Private Sub imgGo_Click()
    Dim oMainDoc        As Word.Document
    Dim sDBPath         As String
    Dim sDocumentName   As String
    Dim sNewName        As String
    
    sMonth = MonthIndex(cbxRenMonth.Value)
    sYear = cbxRenYear.Value
    
    Call BuildQuery
        
    Set oApp = CreateObject("Word.Application")
    
    Call DoCmd.Hourglass(True)

    sDocumentName = REPORT_DIR & "\" & REPORT_TEMPLATE
    sNewName = REPORT_FILE_PREFIX & Format(CStr(Date), "MMM dd yyyy")
    
    Set oMainDoc = oApp.Documents.Open(sDocumentName)
    
    oMainDoc.Application.Visible = False
    
    With oMainDoc.MailMerge
        .MainDocumentType = wdFormLetters
        
        sDBPath = CurrentDb.Name
        .OpenDataSource Name:=sDBPath, _
            SQLStatement:="SELECT * FROM " & REPORT_QRY, _
            SubType:=wdMergeSubTypeWord2000
    End With
    
    'Perform the mail merge to a new document.
    With oMainDoc
        .MailMerge.Destination = wdSendToNewDocument
        Call .MailMerge.Execute(False)
    End With
End Sub

Private Sub oApp_MailMergeAfterMerge(ByVal Doc As Word.Document, ByVal DocResult As Word.Document)
    'Call Doc.Close(False)
    Call DoCmd.Hourglass(False)
    
    oApp.Visible = True
    
    'Merge Now Complete, What Next?
    
    'Save the Document
    On Error Resume Next
    Call oApp.Application.Documents(1).SaveAs(REPORT_DIR & "\" & REPORT_FILE_PREFIX & sMonth & " " & sYear & ".doc")
    
    'Print on White Paper
    If MsgBox("Print renewal notices?", vbYesNo, "Print?") = vbYes Then
        Call oApp.Application.Documents(1).PrintOut(True)
    End If
    
    'Print on Blue Paper
    If MsgBox("Please load blue paper", vbOKCancel, "Print?") = vbOK Then
        Call oApp.Application.Documents(1).PrintOut(True)
    End If
    
    'MsgBox "Mail Merge Complete: " & oApp.ActiveDocument.Name
End Sub

What this does is opens a mail merge template in MS Word and collects all the data for me, so that i can print the info off. BUT:

1.) it seems to open about 5 copies of the database - one after the other. I then have to close the other open versions of the database.

Can anyone help?

Thanks
D

 

[danian]

Can Anyone help?

 

[danian]

Does anyone want to help?

 

[GaryPanic]

Danian

I cannot help on this one - but
why are you using word, Access can do this in reports
what you would end up with is a Form (Lets call it renewals)
this would get all your renewals between 2 dates from and to
and do a standard renewal letter

now you might also want to have some sort of logging of renewal letters so on this you could have a extra field on your d/based called renewalsent (renewal sent) and as part of your renewal system have this populate with a date renewal letter sent -- from the brief outline of what you are doing this has been over complicated


Unless there is some reason for having word docs

g