Access Mail Merge into separate docs

[dboddington]

I have written some code to automate a mail merge which merges an query with a Word MM document. But I want to save each of the letters separately with a descriptive file name. This is the code I have written (thanks to a user here for part of it!). The problems I am trying to solve are (1) I always get an error (462) the first time it is run, the second time seems to be OK, (2) I want to close the final instance of Word down - how can I get a pointer to the instance of Word (3) Can I initially check if Word is running before the MM is done so as to prompt the user to close it? (4) If anyone can think of any way the code can be improved - would be much appreciated...

Private Sub cmdMerge_Click()
    Dim intNumRec As Integer
    Dim strName As String
    Dim rst As ADODB.Recordset
    Dim objWord As Word.Document
    'Need a reference to Microsoft Word 9.0 Object Library
    Dim strSQL As String

    
    Set rst = New ADODB.Recordset
    rst.ActiveConnection = CurrentProject.Connection
    rst.CursorType = adOpenStatic
    rst.Open "SELECT Client from qryAddressInfo"
    
    intNumRec = rst.RecordCount
    
    On Error GoTo ErrorHandler
    
    
    For I = 1 To intNumRec
    
         strSQL = "Select * from [qryAddressInfo] _ 
           Where [Client] = '" & rst![Client] & "'"
         
         Set objWord = GetObject _         
               ("C:\MMDoc.doc","Word.Document")
         'Make Word visible.
         objWord.Application.Visible = True
         'Set the mail merge data source
         objWord.MailMerge.OpenDataSource _
            Name:="C:\My Documents\Merging\MergeDB.mdb", _
            LinkToSource:=True, _
            Connection:="QUERY qryAddressInfo", _
            SQLStatement:=strSQL
            
         'Execute the mail merge.
         objWord.MailMerge.Destination = wdSendToNewDocument
         objWord.MailMerge.Execute
         objWord.Close wdDoNotSaveChanges
         ActiveDocument.SaveAs "C:\"& I & rst![Client] 
         ActiveDocument.Close
         
        rst.MoveNext
    Next
    
Exit Sub

ErrorHandler:
    If Err.Number = 462 Then
        MsgBox "Error encountered - Try Again"
        ActiveDocument.Close
    Else
        MsgBox "Error" & Err.Number & " " & Err.Description
    End If

End Sub

Thanks again!

 

[votegop]

dboddington:

With baited breath I await the answer on this one! If you work it out on your own, please post the answer. Good luck.

Jay

 

[white605]

There is a post in the visual foxpro forum that checks to see if an instance of vfp is running and i have used it with sucess. Since it uses api calls you may be able to adapt the code to vba. The code from the thread is as follows:

Procedure DupStart
#DEFINE SW_NORMAL 1
#DEFINE SW_MAXIMIZE 3
#DEFINE SW_MINIMIZE 6

DECLARE Long FindWindow in Win32API String, String
DECLARE Long BringWindowToTop in Win32API Long
DECLARE Long ShowWindow in Win32API Long, Long

Local lnHWND,lcTitle
lcTitle = _screen.Caption
_screen.Caption = Sys(3)
lnHWND = FindWindow(null,m.lcTitle)
_Screen.Caption = m.lcTitle

IF m.lnHWND >0
BringWindowToTop(m.lnHWND)
ShowWindow(m.lnHWND,SW_MAXIMIZE)
qUIT
ENDIF
ENDPROC

 

[votegop]

For what its worth, I take a different approach. My code does several things: 1) it runs a make-table query to get the desired results; 2) it transfers the resultant table to an unsecured database (avoiding password issues)which will be the datasource for the merge; 3) it opens Word and executes a Macro called "Merge".

The unsecured source .mdb has an "ontimer" event to close after about 7 seconds (only enough time for Word to get the source data and complete the merge).

The "Merge" macro simply executes the merge and closes the original document so the user won't mess with it.

If you do your merge your way dboddington, your users will not have the opportunity to review the documents before saving (that may be to your liking). I need my users to review first.

Now, my approach would be to have a toolbar with a button on it where after the user has reviewed the merged letters and tweaked them, they can hit a "Save Documents" button and have each be saved with a unique name that is derived from a bookmark (a KB article gives good sample code, but the unique name is not based on a bookmark). Unfortunately, Word2000 has issues identified in KB articles that prevents custom toolbars (when in a document based on a custom template) from appearing in the resulting merged documents. Thus I am stuck.

I don't know that any of this helps, but if you'd like me to post my code, I'd be happy. I hope somebody comes along with an idea for both of us.

 

[dboddington]

Thanks white605, I knew I would have to play around with the API. This is a new version of my code - again, it isn't that elegant - but it works. The user I am writing it for wants to merge around 2000 separate documents. votegop - I'd be interested to see your solution. Anyway, here's the code (sorry it's a bit long!)

Option Compare Database
Option Explicit


      Private Declare Function WaitForSingleObject _
         Lib "kernel32" (ByVal hHandle As Long, _
         ByVal dwMilliseconds As Long) As Long

      Private Declare Function FindWindow Lib "user32" _
         Alias "FindWindowA" _
         (ByVal lpClassName As String, _
         ByVal lpWindowName As Long) As Long

      Private Declare Function PostMessage Lib "user32" _
         Alias "PostMessageA" _
         (ByVal hwnd As Long, _
         ByVal wMsg As Long, _
         ByVal wParam As Long, _
         ByVal lParam As Long) As Long

      Private Declare Function IsWindow Lib "user32" _
      (ByVal hwnd As Long) As Long

      'Constants used by the API functions
      Const WM_CLOSE = &H10
      Const INFINITE = &HFFFFFFFF


Private Sub cmdMerge_Click()
    Dim intNumRec As Integer
    Dim strName As String
    Dim rst As ADODB.Recordset
    Dim objWord As Word.Document
    Dim strSQL As String
    Dim I As Integer

    Dim hWindow As Long
    Dim lngResult As Long
    Dim lngReturnValue As Long

      ' this API returns a window handle.
      hWindow = FindWindow("OpusApp", 0&)
 
      If hWindow <> 0 Then
         MsgBox &quot;An instance of Word is running.&quot; & _
                vbCrLf & &quot;Close it down and try again&quot;
         Exit Sub
      End If


    Set rst = New ADODB.Recordset
    rst.ActiveConnection = CurrentProject.Connection
    rst.CursorType = adOpenStatic
    rst.Open &quot;SELECT Client from qryAddressInfo&quot;

    intNumRec = rst.RecordCount

    On Error GoTo ErrorHandler


    For I = 1 To intNumRec

         strSQL = &quot;Select * from [qryAddressInfo] Where _
             [Client] = '&quot; & rst![Client] & &quot;'&quot;

         Set objWord = GetObject(&quot;C:\ToMergeDoc.doc&quot;, _
                         &quot;Word.Document&quot;)
         'Make Word visible.
         objWord.Application.Visible = True
         'Set the mail merge data source
         objWord.MailMerge.OpenDataSource _
            Name:=&quot;C:\MergeDB.mdb&quot;, _
            LinkToSource:=True, _
            Connection:=&quot;QUERY qryAddressInfo&quot;, _
            SQLStatement:=strSQL

         'Execute the mail merge.
         objWord.MailMerge.Destination = _
                            wdSendToNewDocument
         objWord.MailMerge.Execute
         objWord.Close wdDoNotSaveChanges
         
         ActiveDocument.SaveAs &quot;C:\Merged Letters\&quot; _
                & I & rst![Client] & &quot;Letter&quot;
         ActiveDocument.Close


        rst.MoveNext
    Next
'---------------------------------------------------

    ' close the final open instance of Word
    
    hWindow = FindWindow(&quot;OpusApp&quot;, 0&)
    lngReturnValue = PostMessage(hWindow, WM_CLOSE, _
                               vbNull, vbNull)
    lngResult = WaitForSingleObject(hWindow, INFINITE)

'---------------------------------------------------

Exit Sub

ErrorHandler:
    If Err.Number = 462 Then
        MsgBox &quot;Error encountered - Try Again&quot;
        hWindow = FindWindow(&quot;OpusApp&quot;, 0&)
        lngReturnValue = PostMessage(hWindow, WM_CLOSE, vbNull, vbNull)
        lngResult = WaitForSingleObject(hWindow, INFINITE)

    Else
        MsgBox &quot;Error&quot; & Err.Number & &quot; &quot; & Err.Description
    End If

End Sub

If anyone has any suggestions, please post them...