psemianonymous
Programmer
Because some of my reports for my project need to be extremely flexible, I threw up my hands and rewrote them as Word Mailmerge documents. Then I wrote a (very handy, if I do say so myself, which I do) procedure that instamagically opens the appropriate mailmerge document for any passed-in SQL statement.
This works great on my development system, Access 97, Office 2000 (minus Access 2000, of course), Win2K.
For my users, mostly running Office 97, NT4SP6, their user experience ... differs.
This code is not running in production mode, so don't get any ideas yet. I'll be happy to share any changes I make to this process, once I figure out what they are.
Basically, the user's problem is that they get a "Find Data Source" popup on their machine. Simultaneously, I can open the mailmerge document (and no, this isn't a file-locking problem). In fact, I had to email my outputted Word document to the specific user because ... anyway, here's the code. I have highlighted in red the single line where I think the problem is. Any advice, pointers, etc. are appreciated. If I don't get a good response, I'll crosspost to the Word VBA forum and see if I get something there.
Pete
Code:
This works great on my development system, Access 97, Office 2000 (minus Access 2000, of course), Win2K.
For my users, mostly running Office 97, NT4SP6, their user experience ... differs.
This code is not running in production mode, so don't get any ideas yet. I'll be happy to share any changes I make to this process, once I figure out what they are.
Basically, the user's problem is that they get a "Find Data Source" popup on their machine. Simultaneously, I can open the mailmerge document (and no, this isn't a file-locking problem). In fact, I had to email my outputted Word document to the specific user because ... anyway, here's the code. I have highlighted in red the single line where I think the problem is. Any advice, pointers, etc. are appreciated. If I don't get a good response, I'll crosspost to the Word VBA forum and see if I get something there.
Pete
Code:
Code:
Option Compare Database
Option Explicit
'these are the listing of the export specifications.
Public Const trnExDmLicense As String = "exDmLicense"
Public Const trnExDmTraining As String = "exDmTraining"
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
[red]objWordDoc.MailMerge.OpenDataSource _
NAME:=strMailmergeDataFilename, ConfirmConversions:=False, _
ReadOnly:=True, LinkToSource:=True, AddToRecentFiles:=False, _
PasswordDocument:="", PasswordTemplate:="", WritePasswordDocument:="", _
WritePasswordTemplate:="", Revert:=False, Format:=0, _
Connection:="", SQLStatement:="", SQLStatement1:=""[/red]
objWordDoc.MailMerge.Destination = 0 '0 = wdSendToNewDocument
objWordDoc.MailMerge.Execute
Sub_Exit:
On Error Resume Next
objWordDoc.Close SaveChanges:=0 '0 = wdDoNotSaveChanges
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 Database
Dim qdf As 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
On Error GoTo 0
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 -
'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
Err.Clear
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."
Resume Sub_Exit
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)
If Dir(filename) = "" Then
GetPath = ""
Else
GetPath = Left(filename, Len(filename) - Len(Dir(filename)))
End If
End Function