William Hindman
wdhindman at bellsouth.net
Thu Mar 13 09:27:00 CST 2003
Bob
...I use the following code module that was passed to me on this list long
ago ...I call it in an autoexec ...it works for me regardless of the app's
windowed state ...either giving the user a msgbox if the second app is
visible or restoring the first it if its minimized and then closing ...HTH
:)
Option Compare Database
Option Explicit
' Module mdlCheckMultipleInstances
' © Graham Mandeno, Alpha Solutions, Auckland, NZ
' graham at alpha.co.nz
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
William Hindman
"The tree of liberty only grows when watered by the blood of tyrants."
Bertrand Barère de Vieuzac--a Frenchman
----- Original Message -----
From: "Bob Gajewski" <bob at renaissancesiding.com>
To: <AccessD at databaseadvisors.com>
Sent: Thursday, March 13, 2003 8:58 AM
Subject: [AccessD] (A97) Prevent multiple instances of Access
> Dear Fellow Listers:
>
> I am in over my head (again)! I am trying to prevent users from opening a
> second instance of Microsoft Access (A97). The code below was taken
> directly from Microsoft's Knowledge Base (A97=167843, A2K=197593). It
works
> *perfectly* - if the other instance is windowed; it doesn't work at all if
> the other instance is either minimized or maximized. I need it to work no
> matter what the state of the currently running instance.
>
> I placed the CBF in the Switchboard, as my AutoExec macro loads the
> switchboard when the database is opened.
>
> Any suggestions, of course, are greatly appreciated!
>
> TIA,
>
> Bob Gajewski
>
>
> *** SWITCHBOARD CBF ***
> ===============================================
> Private Sub Form_Open(Cancel As Integer)
>
> ' Check for instance of Access already running.
>
> If GetCountOfWindows(hWndAccessApp, "Microsoft Access") > 2 Then
> ' I changed the original value of 1 to 2, as the error condition
> occurred _
> on every initial open when the value was 1.
> Cancel = True
> MsgBox "Please use the instance of Microsoft Access that is " _
> & "already open."
> DoCmd.Quit acQuitSaveNone
> End If
>
> End Sub
> ===============================================
>
>
> *** MODULE "modStartup" ***
> ===============================================
> Option Compare Database
> Option Explicit
>
> '------------------------------------------
> ' Global Declarations Section Of The Module
> '------------------------------------------
>
> Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, _
> ByVal wCmd As Long) As Long
>
> Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" _
> (ByVal hwnd As Long, ByVal lpString As String, ByVal CCh As Long) _
> As Long
>
> Declare Function IsWindowVisible Lib "user32" (ByVal hwnd As Long) _
> As Long
>
> Public Const GW_HWNDFIRST = 0
> Public Const GW_HWNDLAST = 1
> Public Const GW_HWNDNEXT = 2
> Public Const GW_HWNDPREV = 3
>
> ' This function returns the Caption Text of each window passed to
> ' it. If a window does not have a Caption bar, then this function
> ' returns a zero-length string ("")
>
> Function GetAppName(Lnghwnd As Long)
> Dim LngResult As Long
> Dim StrWinText As String * 255
> Dim LngCCh As Long
> LngResult = GetWindowText(Lnghwnd, StrWinText, 255)
> GetAppName = Left(StrWinText, LngResult)
> End Function
>
> ' This function counts all instances of an application that are open,
> ' including any windows that are not visible.
> ' Arguments: LngHwnd = Any valid window handle.
> ' StrAppCaption = The window caption to search for.
> ' Example: GetCountOfWindows(hWndAccessApp,"Microsoft Access")
> Function GetCountOfWindows(Lnghwnd, StrAppCaption)
> Dim LngResult As Long
> Dim LngICount As Long
> Dim StrAppName As String
>
> LngResult = GetWindow(Lnghwnd, GW_HWNDFIRST)
> Do Until LngResult = 0
> If IsWindowVisible(LngResult) Then
> StrAppName = GetAppName(LngResult)
> If InStr(1, StrAppName, StrAppCaption) Then
> LngICount = LngICount + 1
> End If
> End If
> LngResult = GetWindow(LngResult, GW_HWNDNEXT)
> Loop
> GetCountOfWindows = LngICount
> End Function
> ===============================================
>
>
>
>
> _______________________________________________
> AccessD mailing list
> AccessD at databaseadvisors.com
> http://databaseadvisors.com/mailman/listinfo/accessd
> Website: http://www.databaseadvisors.com
>