INTELLIGENT WORK FORUMS
FOR COMPUTER PROFESSIONALS
Come Join Us!
Are you a
Computer / IT professional?
Join Tek-Tips now!
- 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.
Partner With Us!
"Best Of Breed" Forums Add Stickiness To Your Site
(Download This Button Today!)
Feedback
"...I have found your site brilliant. What makes it good are the people that contribute to the site..."
Geography
Where in the world do Tek-Tips members come from?
|
Microsoft: Access Other topics FAQ
|
Mailmerge
|
'Native' mailmerge reports - as painless as possible
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
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
|
Back to Microsoft: Access Other topics FAQ Index
Back to Microsoft: Access Other topics Forum
|
|
 |
|
Talk To Other Members
