By using this site, you agree to our updated Privacy Policy and our Terms of Use. Manage your Cookies Settings.
424,680 Members | 1,868 Online
Bytes IT Community
+ Ask a Question
Need help? Post your question and get tips & solutions from a community of 424,680 IT Pros & Developers. It's quick & easy.

Check for Multiple Instance not working in Access 2003

P: n/a
I use this code in my Access 2K apps to check for multple instances of
my Access2K apps and it works fine on XP and WIn2K OS.

However, trying it on Access 2003/ XP OS it doesn't work and gets stuck
in a loop (Do Until hWndApp = 0)

Any ideas?


Private Const cMaxBuffer = 255

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 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 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, myCaption As String, hWndApp As Long,
hWndDb As Long

myCaption = winGetTitle(winGetHWndDB())
hWndApp = apiGetWindow(apiGetDesktopWindow(), GW_CHILD)
Do Until hWndApp = 0
If hWndApp <> Application.hWndAccessApp Then
hWndDb = winGetHWndDB(hWndApp)
If hWndDb <> 0 Then
If myCaption = winGetTitle(hWndDb) Then Exit Do
End If
End If
hWndApp = apiGetWindow(hWndApp, GW_HWNDNEXT)
Loop
If hWndApp = 0 Then Exit Function

'leaving this code in allows the user the option of opening another
instance:
'*If fConfirm Then
'* If MsgBox(myCaption & " is already open" & vbCrLf & vbCrLf &
"" _
'* & "Do you want to open a second instance of this database?",
_
'* vbYesNo Or vbQuestion Or vbDefaultButton2) = vbYes Then Exit
Function
'*End If

If fConfirm Then
msgbox "You cannot open a second instance of this database."
End If

apiSetActiveWindow hWndApp

If apiIsIconic(hWndApp) Then
apiShowWindowAsync hWndApp, SW_RESTORE
Else
apiShowWindowAsync hWndApp, SW_SHOW
End If
DoCmd.Quit

End Function

Nov 13 '05 #1
Share this question for a faster answer!
Share on Google+

This discussion thread is closed

Replies have been disabled for this discussion.