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
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
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
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
Sub_Exit: On Error Resume Next CurrentDb.QueryDefs.Delete strQdfName
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
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