Article ID: 197593
Article Last Modified on 10/11/2006
96591 ACC: Determining How Many Instances of Application Are Active
167843 ACC: Determining How Many Instances of Application Are Active
'------------------------------------------ ' 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
Private Sub Form_Open(Cancel As Integer)
If GetCountOfWindows(hWndAccessApp, "Microsoft Access") > 1 Then
Cancel = True
MsgBox "Please use the instance of Microsoft Access that is " _
& "already open."
DoCmd.Quit acQuitSaveNone
End If
End Sub
Keywords: kbhowto kbinterop kbprogramming KB197593