Automated Mail Merge from Access 1

[jabrony76]

Hi all -
I've got a fairly simple automated system of Mail Merge from Access but I have one procedure that I would like to do but cannot figure out. I have the following Code:

[red]
Function DenialMerge()
Dim objWord As Word.Document
Set objWord = GetObject("C:\Denial.doc", "Word.Document&quot
' Show Word.
objWord.Application.Visible = True
' Set the data source of the merge to CCDB.
objWord.MailMerge.OpenDataSource _
Name:="S:\CCDBv3.0\Front_End\CCDB_v3.01.mdb", _
LinkToSource:=True, _
Connection:="QUERY qry_Denial_Form_Test", _
SQLStatement:="SELECT * FROM [qry_Denial_Form_Test]"
' Run it!
objWord.MailMerge.Execute
' Protect Denial Worsheet!
ActiveDocument.Protect Password:="password", NoReset:=
False, Type:= _wdAllowOnlyFormFields

End Function
[/red]


This works well and merges a document with basic demographics, and then locks that document so combo boxes on the document work for further work by the end user.

Problem is, when I run the code, the original document "Denial.doc" remains open after the merge has occurred along with the "Form Letter1" Document. Is there any way to close just the original "Denial.doc" without closing the Merge result "Form Letter1"?

Thanks!!
Andy

 

[BillPower]

Hi jabrony76

Paste the following into a global module:

Declare Function EnumWindows Lib "user32.dll" (ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
Declare Function GetWindowTextLength Lib "user32.dll" Alias "GetWindowTextLengthA" (ByVal hWnd As Long) As Long
Declare Function GetWindowText Lib "user32.dll" Alias "GetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hWnd As Long, ByVal Msg As Long, wParam As Any, lParam As Any) As Long

Public Const WM_CLOSE = &H10
Global gf_Name As String

Public Function EnumWindowsProc(ByVal hWnd As Long, ByVal lParam As Long) As Long
On Error Resume Next
Dim slength As Long, TitleBar As String
Dim retval As Long
Static winnum As Integer
winnum = winnum + 1
slength = GetWindowTextLength(hWnd) + 1
If slength > 1 Then
TitleBar = Space(slength)
retval = GetWindowText(hWnd, TitleBar, slength)

If Left(TitleBar, Len(gf_Name)) = gf_Name Then
If hWnd <> ghWnd Then
Call SendMessage(hWnd, WM_CLOSE, 0&, 0&)
End If
End If
End If
EnumWindowsProc = 1
End Function

Change your existing function as below:

Function DenialMerge()
Dim objWord As Word.Document
gf_Name = &quot;Denial.doc&quot;
Set objWord = GetObject(&quot;C:\Denial.doc&quot;, &quot;Word.Document&quot
' Show Word.
objWord.Application.Visible = True
' Set the data source of the merge to CCDB.
objWord.MailMerge.OpenDataSource _
Name:=&quot;S:\CCDBv3.0\Front_End\CCDB_v3.01.mdb&quot;, _
LinkToSource:=True, _
Connection:=&quot;QUERY qry_Denial_Form_Test&quot;, _
SQLStatement:=&quot;SELECT * FROM [qry_Denial_Form_Test]&quot;
' Run it!
objWord.MailMerge.Execute
' Protect Denial Worsheet!
ActiveDocument.Protect Password:=&quot;password&quot;, NoReset:=
False, Type:= _wdAllowOnlyFormFields

DoEvents
Call EnumWindows(AddressOf EnumWindowsProc, 0)

End Function

This is a variation of the EnumWindows API Function. Sends a message to an application to close gf_Name if it is visible on the title bar. Will work in any VBA or VB module, Access, Word, Excel etc.

Let me know if there are any problems with it.

Bill

 

[jabrony76]

Bill -

This worked excellent!! Thank you very much! and a follow up question... I would like to use this code to save my Merged Letter to a static location. I've modified it a bit to include a second &quot;gf_Name&quot; as &quot;gf_Name_Save&quot; and call it in the original merge code by stating &quot;gf_Name_Save = Form Letters1&quot;

I added the below code (in red) as Dim for the file name and a second If statement and it doesn't seem to be working. Can you please let me know if this is possible and how? Thanks again!!

Andy

------------------------------------------

Option Compare Database

Declare Function EnumWindows Lib &quot;user32.dll&quot; (ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
Declare Function GetWindowTextLength Lib &quot;user32.dll&quot; Alias &quot;GetWindowTextLengthA&quot; (ByVal hWnd As Long) As Long
Declare Function GetWindowText Lib &quot;user32.dll&quot; Alias &quot;GetWindowTextA&quot; (ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Declare Function SendMessage Lib &quot;user32.dll&quot; Alias &quot;SendMessageA&quot; (ByVal hWnd As Long, ByVal Msg As Long, wParam As Any, lParam As Any) As Long

Public Const WM_CLOSE = &H10
Global gf_Name As String
[red]Global gf_Name_Save As String[/red]

Public Function EnumWindowsProc(ByVal hWnd As Long, ByVal lParam As Long) As Long
On Error Resume Next
Dim slength As Long, TitleBar As String
Dim retval As Long
[red]Dim vLName As String, vFName As String, vCMM As Integer, vAdmit As String, vFileName As String
Dim vDirectory As String

vLName = Forms![frm_Denial_Form_Anc]![Last Name]
vFName = Forms![frm_Denial_Form_Anc]![First Name]
vCMM = Forms![frm_Denial_Form_Anc]![CMM]
vAdmit = Forms![frm_Denial_Form_Anc]![Admit Date]
vDirectory = &quot;S:\CCDBv3.0\DenialWkshts\&quot;
vFileName = vDirectory & vLName & &quot;,&quot; & vFName & &quot;-&quot; & vCMM & &quot;-&quot; & &quot;-Denial_Wrksheet.doc&quot;[/red]

Static winnum As Integer
winnum = winnum + 1
slength = GetWindowTextLength(hWnd) + 1
If slength > 1 Then
TitleBar = Space(slength)
retval = GetWindowText(hWnd, TitleBar, slength)

If Left(TitleBar, Len(gf_Name)) = gf_Name Then
If hWnd <> ghWnd Then
Call SendMessage(hWnd, WM_CLOSE, 0&, 0&)
End If

[red]If Left(TitleBar, Len(gf_Name)) = gf_Name_Save Then
objWord.SaveAs vFileName
End If[/red]

End If
End If
EnumWindowsProc = 1
End Function

 

[BillPower]

Hi Andy,

Declare objWord and vFileName as global variables in the module you declared gf_Name_Save.

Cut this from the global module and paste into your Function DenialMerge():

Dim vLName As String, vFName As String, vCMM As Integer, vAdmit As String, vFileName As String
Dim vDirectory As String ’ delete this and declare as above

vLName = Forms![frm_Denial_Form_Anc]![Last Name]
vFName = Forms![frm_Denial_Form_Anc]![First Name]
vCMM = Forms![frm_Denial_Form_Anc]![CMM]
vAdmit = Forms![frm_Denial_Form_Anc]![Admit Date]
vDirectory = &quot;S:\CCDBv3.0\DenialWkshts\&quot;
vFileName = vDirectory & vLName & &quot;,&quot; & vFName & &quot;-&quot; & vCMM & &quot;-&quot; & &quot;-Denial_Wrksheet.doc&quot;

‘paste it here before:

DoEvents
Call EnumWindows(AddressOf EnumWindowsProc, 0)

Your final code should now be exactly like this:
------------------------------------------------------------

Function DenialMerge()
Dim vLName As String, vFName As String, vCMM As Integer, vAdmit As String
Dim vDirectory As String
gf_Name = &quot;Denial.doc&quot;
Set objWord = GetObject(&quot;C:\Denial.doc&quot;, &quot;Word.Document&quot
' Show Word.
objWord.Application.Visible = True
' Set the data source of the merge to CCDB.
objWord.MailMerge.OpenDataSource _
Name:=&quot;S:\CCDBv3.0\Front_End\CCDB_v3.01.mdb&quot;, _
LinkToSource:=True, _
Connection:=&quot;QUERY qry_Denial_Form_Test&quot;, _
SQLStatement:=&quot;SELECT * FROM [qry_Denial_Form_Test]&quot;
' Run it!
objWord.MailMerge.Execute
' Protect Denial Worsheet!
ActiveDocument.Protect Password:=&quot;password&quot;, NoReset:=
False, Type:= _wdAllowOnlyFormFields

vLName = Me![Last Name]
vFName = Me![First Name]
vCMM = Me!CMM
vAdmit = Me![Admit Date]
vDirectory = &quot;S:\CCDBv3.0\DenialWkshts\&quot;
vFileName = vDirectory & vLName & &quot;,&quot; & vFName & &quot;-&quot; & vCMM & &quot;-&quot; & &quot;-Denial_Wrksheet.doc&quot;

DoEvents
Call EnumWindows(AddressOf EnumWindowsProc, 0)
End Function
------------------------------------------------------------

Your Global Module should look like this:
------------------------------------------------------------
Option Compare Database
Option Explicit

Declare Function EnumWindows Lib &quot;user32.dll&quot; (ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
Declare Function GetWindowTextLength Lib &quot;user32.dll&quot; Alias &quot;GetWindowTextLengthA&quot; (ByVal hWnd As Long) As Long
Declare Function GetWindowText Lib &quot;user32.dll&quot; Alias &quot;GetWindowTextA&quot; (ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Declare Function SendMessage Lib &quot;user32.dll&quot; Alias &quot;SendMessageA&quot; (ByVal hWnd As Long, ByVal Msg As Long, wParam As Any, lParam As Any) As Long

Public Const WM_CLOSE = &H10
Global gf_Name As String
Global gf_Name_Save As String
Global vFileName As String
Global objWord As Word.Document

Public Function EnumWindowsProc(ByVal hWnd As Long, ByVal lParam As Long) As Long
On Error Resume Next
Dim slength As Long, TitleBar As String
Dim retval As Long

Static winnum As Integer
winnum = winnum + 1
slength = GetWindowTextLength(hWnd) + 1
If slength > 1 Then
TitleBar = Space(slength)
retval = GetWindowText(hWnd, TitleBar, slength)

If Left(TitleBar, Len(gf_Name)) = gf_Name Then
If hWnd <> ghWnd Then
Call SendMessage(hWnd, WM_CLOSE, 0&, 0&)
End If

If Left(TitleBar, Len(gf_Name)) = gf_Name_Save Then
objWord.SaveAs vFileName
End If

End If
End If
EnumWindowsProc = 1
End Function
------------------------------------------------------------

The main problem with your additions was that objWord didn't exist at the time it was being called by EnumWindowsProc.

If this doesn’t work, let me know.

Bill