Contact US

Log In

Come Join Us!

Are you a
Computer / IT professional?
Join Tek-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!

*Tek-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Students Click Here

Microsoft: Access Other topics FAQ


'Native' mailmerge reports - as painless as possible by psemianonymous
Posted: 30 Apr 04 (Edited 30 Apr 04)

So a lot of us don't use mailmerge, partially because it's so painful to do so.  You have to 1) make a query, 2) make the mailmerge document point back to that query, 3) allow for Word to seperately open that query everytime mailmerge is run, which may or may not open another Access application in the process, and given the roll of the dice, may not work at all.  Sending multiple mailmerges in this way can be painful past the point of frustration.

Enter my solution.  It requires that you have 1) a working text export specification, 2) a sample text file containing data using those specific fields, and of course, 3) a Word mailmerge document.  That is all.

The single entry point for this code module is RunMailmerge.  You pass in the SQL SELECT statement, you pass in the text export specification name, and you pass in the destination document file.  Currently it is programmed to look for the destination document in a subdirectory of your database backend, but you can redefine this quite easily (just change the GetStartDirectory() function to whatever, or eliminate it completely).

Basically, this enables you to pass in a very complicated SQL SELECT statement, with any number of 'parameters', and then opens the mailmerge document like any internal Access report.

Additionally, I've tried my hardest to cover every possible error, including empty recordsets, missing mailmerge files, etc, and gracefully retreating when such an error occurs, thus leaving no footprint.  This process should be transparent, as I programmed it to be.

This code has been in production for nearly a month now with no errors (though I found a few myself, so I don't claim it's bug-free).  Use/abuse/let me know if anything goes wrong.  I do read FAQ comments, so definitely let me know if you find anything broken.

Hypothetical sample usage:

Private Sub cmdPrintInvoice_Click()
    RunMailmerge "SELECT * FROM qryInvoicesFormatted " & _
        "WHERE CustID = " & txtCustID.Value & _
        " AND SaleDate = #" & _
        Format(txtSaleDate.Value, "mm/dd/yyyy") & _
        "#", "exInvoice", "invoice.doc"
End Sub

The above would open the mailmerge document, run the merge, close the mailmerge document itself.  You would be left with a window showing 'Form Letters 1', which you could then print like a report, save as any other Word .DOC, or just view and discard.  This process really takes the pain out of using Mailmerge, and only takes a few steps to set up.  The best part about this, is that (my users in particular) can tweak each report manually, or can tweak the mailmerge template itself!

Below is the entire code module.

Option Compare Database
Option Explicit

'these are the listing of the export specifications.
Public Const exExampleSpec1 As String = "exSpec1"
Public Const exExampleSpec2 As String = "exSpec2"

Public Sub RunMailmerge(SQL As String, ExportSpecificationName As String, MergeDocumentFilename As String)
On Error GoTo Sub_Error
    Dim objWordDoc As Object
    Dim strMailmergeDataFilename As String
    strMailmergeDataFilename = GetStartDirectory() & Year(DATE) & "_" & Month(DATE) & "_" & Day(DATE) & "_" & Hour(Now) & "_" & Minute(Now) & "_" & Second(Now) & ".txt"
    ExportSqlSelectStatementToCsv SQL, ExportSpecificationName, strMailmergeDataFilename
    Set objWordDoc = GetObject(GetStartDirectory() & MergeDocumentFilename, "Word.Document")
    objWordDoc.Application.Visible = True
    'Format:=0 '0 = wdOpenFormatAuto
    objWordDoc.MailMerge.OpenDataSource _
        NAME:=strMailmergeDataFilename, ConfirmConversions:=False, _
        ReadOnly:=False, LinkToSource:=True, AddToRecentFiles:=False, _
        PasswordDocument:="", PasswordTemplate:="", WritePasswordDocument:="", _
        WritePasswordTemplate:="", Revert:=False, Format:=0, _
        Connection:="", SQLStatement:="", SQLStatement1:=""

    objWordDoc.MailMerge.Destination = 0 '0 = wdSendToNewDocument
On Error Resume Next
    'originally I didn't want to 'save' the mailmerge template document, but I am forced to.
    'this is because if you *already have a Word document open* when you run this code,
    'Word has some unexpected behavior: it pops up a messagebox to confirm saving the document,
    'even if you specifically set it to "wdDoNotSaveChanges".  So to eliminate this problem
    'completely, we first SAVE the document, THEN close it.  This way there's no way the prompt
    'will appear.
    objWordDoc.Close SaveChanges:=-1 '-1 = wdSaveChanges
    Set objWordDoc = Nothing
    'attempt to delete file, silently fail on errors.
    FileSystem.Kill strMailmergeDataFilename
    Exit Sub
    If Err.Number = 432 Then
        MsgBox "ERROR: Invalid filename provided: '" & strMailmergeDataFilename & "' or " & _
        "'" & GetStartDirectory() & MergeDocumentFilename & "'."
        MsgBox Err.Description
    End If
    Resume Sub_Exit
End Sub

Public Sub ExportSqlSelectStatementToCsv(SQL As String, ExportSpecificationName As String, FullPathAndFilename As String)
On Error GoTo Sub_Error
    '-create a new querydef with the SQL parameter as its SQL.
    'save & attach this querydef.
    'run the TransferText on this temp querydef,
    'delete the querydef
    Dim strQdfName As String
    Dim db As DAO.Database
    Dim qdf As DAO.QueryDef
    strQdfName = "~temp_mailmerge_" & Year(DATE) & "_" & Month(DATE) & "_" & Day(DATE) & "_" & Hour(Now) & "_" & Minute(Now) & "_" & Second(Now)

    Set db = CurrentDb
    Set qdf = db.CreateQueryDef(strQdfName, SQL)
    Set qdf = Nothing
    Set db = Nothing
    If Nz(DCount("*", strQdfName), 0) <= 0 Then
        'in this case, if the query is empty/contains no entries, we
        'should pop up a custom error message.  Basically we shouldn't attempt to
        'run the mailmerge if there's no data anyway, right?
        'So we have to turn off the standard error handling, delete the query (otherwise
        'the query is not deleted), and raise the error.
        'the calling function "RunMailmerge" will catch and handle the error, and then
        'gracefully exit.
        On Error GoTo 0
        CurrentDb.QueryDefs.Delete strQdfName
        Err.Raise vbObjectError + 1024 + 2, "Query Export to CSV", "The report has no data, and thus cannot properly merge."
    End If
    AttemptToDeleteFile FullPathAndFilename
    DoCmd.TransferText acExportDelim, ExportSpecificationName, strQdfName, FullPathAndFilename, True

On Error Resume Next
    CurrentDb.QueryDefs.Delete strQdfName
    Exit Sub
    MsgBox Err.Description
    Resume Sub_Exit
End Sub

'AttemptToDeleteFile -
'attempts to delete the mailmerge.txt file located in the database directory.
'Basically provides error-handling capabilities to the single "Kill" method call.

Private Sub AttemptToDeleteFile(strFilename As String)
On Error GoTo Sub_Error
    Kill strFilename
    Exit Sub
    If Err.Number = 53 Then 'err 53 = file not found, that means the file is already deleted!
        'no error, continue
        Resume Sub_Exit
    ElseIf MsgBox("Cannot delete file.  Close all Word mailmerge documents and click Retry.", vbRetryCancel + vbExclamation, "File In Use") = vbRetry Then
        On Error GoTo 0
        Err.Raise vbObjectError + 1024 + 1, "file in use", "File In Use@" & _
                    "Cannot complete the mailmerge process because the file '" & strFilename & "' " & _
                    "is in use.  Close all Word mailmerge documents and try again."
    End If
End Sub

Private Function GetStartDirectory() As String
    GetStartDirectory = CurrentBackendPath() & "mm\"
End Function

Private Function CurrentBackendPath() As String
Const JETDBPrefix As String = ";DATABASE="
Const strTableName As String = "GLOBALS"

    Dim str As String
    Dim idx As Integer
    str = CurrentDb().TableDefs(strTableName).Connect
    idx = InStr(1, str, JETDBPrefix, vbTextCompare)
    str = Mid(str, idx + Len(JETDBPrefix))
    CurrentBackendPath = GetPath(str)
End Function

Private Function GetPath(FileName As String) As String
    If Dir(FileName) = "" Then
        GetPath = ""
        GetPath = Left(FileName, Len(FileName) - Len(Dir(FileName)))
    End If
End Function

Back to Microsoft: Access Other topics FAQ Index
Back to Microsoft: Access Other topics Forum

My Archive

Close Box

Join Tek-Tips® Today!

Join your peers on the Internet's largest technical computer professional community.
It's easy to join and it's free.

Here's Why Members Love Tek-Tips Forums:

Register now while it's still free!

Already a member? Close this window and log in.

Join Us             Close