View Single Post
  #4  
Old March 18th, 2010, 03:16 PM posted to microsoft.public.access
ann
external usenet poster
 
Posts: 462
Default Multiple Databases Open

I found the code and explanation listed below but I'm not a programmer so I'm
not really sure where to put this. Can anyone help me out? Thanks.

This solution uses the titlebar of the database window. It checks each
other instance of Access currently running and if the titlebar of the ODb
class window matches the active instance then it activates the other instance
and terminates the current one. An optional boolean argument fConfirm causes
a confirmation message to be displayed before switching and terminating (the
default for fConfirm is True). The function winCheckMultipleInstances can be
called from initialisation code, or even directly from AutoExec:

RunCode
=winCheckMultipleInstances(False)

'******************** Code Start ********************
' Module mdlCheckMultipleInstances
' © Graham Mandeno, Alpha Solutions, Auckland, NZ
'
' This code may be used and distributed freely on the condition
' that the above credit is included unchanged.

Private Const cMaxBuffer = 255

Private Declare Function apiGetClassName Lib "user32" _
Alias "GetClassNameA" _
(ByVal hWnd As Long, _
ByVal lpClassName As String, _
ByVal nMaxCount As Long) _
As Long

Private Declare Function apiGetDesktopWindow Lib "user32" _
Alias "GetDesktopWindow" _
() As Long

Private Declare Function apiGetWindow Lib "user32" _
Alias "GetWindow" _
(ByVal hWnd As Long, _
ByVal wCmd As Long) _
As Long

Private Const GW_CHILD = 5
Private Const GW_HWNDNEXT = 2

Private Declare Function apiGetWindowText Lib "user32" _
Alias "GetWindowTextA" _
(ByVal hWnd As Long, _
ByVal lpString As String, _
ByVal aint As Long) _
As Long

Private Declare Function apiSetActiveWindow Lib "user32" _
Alias "SetActiveWindow" _
(ByVal hWnd As Long) _
As Long

Private Declare Function apiIsIconic Lib "user32" _
Alias "IsIconic" _
(ByVal hWnd As Long) _
As Long

Private Declare Function apiShowWindowAsync Lib "user32" _
Alias "ShowWindowAsync" _
(ByVal hWnd As Long, _
ByVal nCmdShow As Long) _
As Long

Private Const SW_SHOW = 5
Private Const SW_RESTORE = 9

Public Function winGetClassName(hWnd As Long) As String
Dim sBuffer As String, iLen As Integer
sBuffer = String$(cMaxBuffer - 1, 0)
iLen = apiGetClassName(hWnd, sBuffer, cMaxBuffer)
If iLen 0 Then
winGetClassName = Left$(sBuffer, iLen)
End If
End Function

Public Function winGetTitle(hWnd As Long) As String
Dim sBuffer As String, iLen As Integer
sBuffer = String$(cMaxBuffer - 1, 0)
iLen = apiGetWindowText(hWnd, sBuffer, cMaxBuffer)
If iLen 0 Then
winGetTitle = Left$(sBuffer, iLen)
End If
End Function

Public Function winGetHWndDB(Optional hWndApp As Long) As Long
Dim hWnd As Long
winGetHWndDB = 0
If hWndApp 0 Then
If winGetClassName(hWndApp) "OMain" Then Exit Function
End If
hWnd = winGetHWndMDI(hWndApp)
If hWnd = 0 Then Exit Function
hWnd = apiGetWindow(hWnd, GW_CHILD)
Do Until hWnd = 0
If winGetClassName(hWnd) = "ODb" Then
winGetHWndDB = hWnd
Exit Do
End If
hWnd = apiGetWindow(hWnd, GW_HWNDNEXT)
Loop
End Function

Public Function winGetHWndMDI(Optional hWndApp As Long) As Long
Dim hWnd As Long
winGetHWndMDI = 0
If hWndApp = 0 Then hWndApp = Application.hWndAccessApp
hWnd = apiGetWindow(hWndApp, GW_CHILD)
Do Until hWnd = 0
If winGetClassName(hWnd) = "MDIClient" Then
winGetHWndMDI = hWnd
Exit Do
End If
hWnd = apiGetWindow(hWnd, GW_HWNDNEXT)
Loop
End Function

Public Function winCheckMultipleInstances(Optional fConfirm As Boolean =
True) As Boolean
Dim fSwitch As Boolean, sMyCaption As String
Dim hWndApp As Long, hWndDb As Long
On Error GoTo ProcErr
sMyCaption = winGetTitle(winGetHWndDB())
hWndApp = apiGetWindow(apiGetDesktopWindow(), GW_CHILD)
Do Until hWndApp = 0
If hWndApp Application.hWndAccessApp Then
hWndDb = winGetHWndDB(hWndApp)
If hWndDb 0 Then
If sMyCaption = winGetTitle(hWndDb) Then Exit Do
End If
End If
hWndApp = apiGetWindow(hWndApp, GW_HWNDNEXT)
Loop
If hWndApp = 0 Then Exit Function
If fConfirm Then
If MsgBox(sMyCaption & " is already open@" _
& "Do you want to open a second instance of this database?@", _
vbYesNo Or vbQuestion Or vbDefaultButton2) = vbYes Then Exit Function
End If
apiSetActiveWindow hWndApp
If apiIsIconic(hWndApp) Then
apiShowWindowAsync hWndApp, SW_RESTORE
Else
apiShowWindowAsync hWndApp, SW_SHOW
End If
Application.Quit
ProcEnd:
Exit Function
ProcErr:
MsgBox Err.Description
Resume ProcEnd
End Function
'******************** Code End ********************


"Ann" wrote:

If it were just me I would too but I developed the database and she is my
customer and she would like it fixed. Hopefully, someone knows how since I
don't have a clue as to why it's happening.

"Jerry Whittle" wrote:

I have seen this also. It still works so I just ignored it.
--
Jerry Whittle, Microsoft Access MVP
Light. Strong. Cheap. Pick two. Keith Bontrager - Bicycle Builder.


"Ann" wrote:

I am working with Access 2002. I have a database with a button on the
Switchboard that opens a Word mail merge using an Access query for the data.
It is set to merge the letters for the records in the query when it opens.
This works fine for me but when the other user clicks the button it opens a
second copy of the database. Has anyone had this problem and how do I fix
it? Thanks in advance.