Mailmerge opens 2nd instance of Access - a workaround!!!!

[Jim]

Like a lot of people, I have been plagued with mailmerge opening a
second instance of Access. And like a lot of people, none of the
commonly suggested 'fixes' work. I have tried the solutions offered by
Microsoft and those posted on www.mvps.org/access and similar sites
(mostly suggesting changing the application title back to "Microsoft
Access"). None of these worked for me at all.

However, after playing around for a long time, I have found what to me
seems like a perfectly simple and effective 'workaround.' The below
four steps show you how I achieved this. I hope some of you find this
useful.

Cheers
Jim

1. Create a new database called, for example, mailmerge.mdb, and link
the tables through to the main database. Then add the relevant queries
to this database for mailmerging. Change the application title
(Tools->Startup) to "mailmerge". It's important that you don't have
any other apps called this running at the same time.

2. Link your mailmerge documents to this new database, rather than
your existing database. SQL strings can still be passed to these word
docs through the form's code.

3. This is my mailmerge form code. The function in the last line kills
the mailmerge.mdb process. This function is described in step 4.

Dim wapp As New Word.Application
Dim objWord As Word.Document
'strFilename is the mailmerge doc
Set objWord = wapp.Documents.Open(strFileName)
objWord.MailMerge.OpenDataSource _
Name:="\\PATHNAME\mailmerge.mdb", LinkToSource:=True, _
Connection:=strConnection, SQLStatement:=strSQL
objWord.MailMerge.Destination = wdSendToNewDocument
objWord.MailMerge.SuppressBlankLines = True
objWord.MailMerge.Execute
wapp.ActiveDocument.PrintOut
'saves new doc as strOutputFullFileName
wapp.ActiveDocument.SaveAs strOutputFullFileName
wapp.ActiveDocument.Close False
wapp.ActiveDocument.Close False
wapp.Quit
Set objWord = Nothing
Set wapp = Nothing
fnCloseWindow "mailmerge"

4. The below code should be added to a new module, which is where the
function fnCloseWindow can be found:

Public Const WM_CLOSE = &H10
Public Const INFINITE = &HFFFFFFFF

Public Declare Function apiFindWindow Lib "user32" Alias _
"FindWindowA" (ByVal strClass As String, ByVal
lpWindow As String) As Long

Public Declare Function apiPostMessage Lib "user32" Alias
"PostMessageA" _
(ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam
As Long, _
lParam As Any) As Long

Public Declare Function apiGetWindowThreadProcessId _
Lib "user32" Alias "GetWindowThreadProcessId" (ByVal
hWnd As Long, _
lpdwProcessID As Long) As Long

Public Declare Function apiWaitForSingleObject Lib "kernel32" Alias
"WaitForSingleObject" _
(ByVal hHandle As Long, ByVal dwMilliseconds As Long)
As Long

Function fnCloseWindow(ByVal strAppTitle As String) As Boolean
Dim lngH As Long, fCloseApp
On Local Error GoTo fnCloseWindow_Err
lngH = apiFindWindow(vbNullString, strAppTitle)
If (lngH) Then
lngRet = apiPostMessage(lngH, WM_CLOSE, 0, ByVal 0&)
Call apiGetWindowThreadProcessId(lngH, PID)
Call apiWaitForSingleObject(PID, INFINITE)
End If
fnCloseWindow = True
fnCloseWindow_Exit:
Exit Function
fnCloseWindow_Err:
fnCloseWindow = False
Resume fnCloseWindow_Exit
End Function