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 >