Mutliple Databases Open for Some Users

[Ann]

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
' (e-mail address removed)
' 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 ********************

 

[Steve Sanford]

Hi Ann,

1) Open your database. If you have set startup options, hold down the shift
key when opening the MDB.

2) Press <ctrl>- G to open the IDE

3) In the menu bar, click on INSERT, then MODULE (not Class module)

4) Paste everything between (including) the "Code Start" and "Code End" lines
into the module. (Watch for line wrap)

5) Compile the code (DEBUG/COMPILE) . Fix any errors.

6) Save the module. Name it mdlCheckMultipleInstances


HTH

 

[Ann]

Hi Steve,

Thanks so much for the help. I followed your instructions but am I supposed
to do something with the code below because it didn't work. I tried putting
this in the On Click event of the button that opens the mail merge but it
didn't work. I don't want it on AutoExec since it doesn't happen when I open
the database and I'm not sure what Initialization code is. Those were the
two options from the code I found.

RunCode=winCheckMultipleInstances(False)

 

[Steve Sanford]

Hi Ann,

So you open your database, then walk away. Then, 45 minutes later, you come
back and open another instance of your database. That's the problem, yes?

Somewhere you have to call the function that checks for a current running
instance of the database. "It can be from initialisation code, or even
directly from AutoExec".... means you have to check before anything happens.


I don't know if this will work, but try this:

ON A COPY of your database, create a new form. Add a text box. In the open
event of this form, try this code

Private Sub Form_Open(Cancel As Integer)
Dim RunCode

' the function below doesn't return anything,
' so the type doesn't matter

RunCode=winCheckMultipleInstances(False)

End Sub


Save the database.

** I did say to use a COPY, Right???


Now open your database. (--The copy--)

Next open your database again (--also the copy--), this time holding down
the shift key. Then open the new form. You should switch to the first
instance of the database and the second instance should quit.


HTH

 

[Ann]

Hi,

No it's not that the user is accidentally opening another database. She
gets a second copy of the database when she clicks a button to open a Word
Mail Merge that uses an Access query as the data file. This only happens to
her, it's fine for me.