'Native' mailmerge reports - as painless as possible

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:

[tt]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[/tt]

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.


[tt]
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"


[red]Public Sub RunMailmerge(SQL As String, ExportSpecificationName As String, MergeDocumentFilename As String)[/red]
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

objWordDoc.MailMerge.Execute

Sub_Exit:
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.Save
objWordDoc.Close SaveChanges:=-1 '-1 = wdSaveChanges

Set objWordDoc = Nothing
'attempt to delete file, silently fail on errors.
FileSystem.Kill strMailmergeDataFilename

Exit Sub

Sub_Error:
If Err.Number = 432 Then
MsgBox "ERROR: Invalid filename provided: '" & strMailmergeDataFilename & "' or " & _
"'" & GetStartDirectory() & MergeDocumentFilename & "'."
Else
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
'steps:
'-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


Sub_Exit:
On Error Resume Next
CurrentDb.QueryDefs.Delete strQdfName

Exit Sub

Sub_Error:
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

Sub_Exit:
Exit Sub

Sub_Error:
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
Resume
Else
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 = ""
Else
GetPath = Left(FileName, Len(FileName) - Len(Dir(FileName)))
End If
End Function

[/tt]