Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations Chriss Miller on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Mailmerge problem 1

Status
Not open for further replies.

psemianonymous

Programmer
Dec 2, 2002
1,877
US
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:
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
 
After more research, it turns out that:

1. It looks like I'm opening the data source properly, so the highlighted text isn't what's going wrong. So far as I know. I was hoping for a quick "change that to foo" answer, but apparently there isn't one.

2. It turns out that the specific user machine causing the problem is running Access97/Office2000/Win2K just like me, so versioning problems are very unlikely.

3. One thing I couldn't test as well as I'd like is the networking layer--but my friendly (fellow) IT person has set up a regular user and let me test the specific settings. It was possibly an error that I use UNC's to link to my backend tables, which (as you may be able to tell, all the way at the bottom) is where I get my base directory from. I grab the table 'GLOBALS' and its Connect property, parse that and grab the directory from there. So it's possible that Word was puking on the "\\server\dir\dir\dir\2004_4_5_14_56_04.txt" style filenames. BUT it isn't, because I've tested for that myself, as of ten minutes ago. AND I've reset the UNC table links to network-drive table links (M:\dir\dir\dir\2004_4_5_14_56_04.txt) and that tested fine, too. No help there either.


So now I'm left with just a few options:
1. PEBKAC error (unlikely! but possible, always possible)
2. Word-related problem, i.e. they already had a document open when I started to run all the Automation business, or specifically
3. File-related problem, i.e. the mailmerge document was already open, or the 'temp' text filename is too long, or ... something crazy like that. The worst problem is that I can't reproduce the problem; I'll visit the offending machine later today if necessary.


I'll post back if I figure out what's going on.


Pete
 
Third update: I'm completely stumped, but joyfully so. I cannot get the code to break, for any reason, on anyone's machine. So I've tentatively put the release back into production, with instructions to let me know when something breaks. The only tweak I've made from the above code is that I now save the original Mailmerge document, to avoid a messagebox that did appear on one user's computer.

This:
objWordDoc.Close SaveChanges:=0 '0 = wdDoNotSaveChanges

becomes:
objWordDoc.Close SaveChanges:=1 '1 = something else


Other than that, the code works as advertised: put in a valid SQL statement (usually I have a base query, then just run a SELECT * FROM qryQueryName WHERE [specific filter]). So put in valid SQL, a related text export specification name (create by doing a manual export of the base query, it's what I did), and a valid mailmerge document name in the ".\mm\" folder. Obviously you can customize the folder directories, etc.


So I'd like to get others using this code so we can all fix the bugs. So if you find that this doesn't work for some reason, let me know, and I'll amend the above code. Maybe it will help me.


Pete
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top