Option Compare Database
Option Explicit

Public Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
Public Declare Function IsWindowVisible Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" _
    (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long


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


Function GetCountOfWindows(Lnghwnd, StrAppCaption)
Dim LngResult As Long
Dim LngICount As Long
Dim StrAppName As String

LngResult = GetWindow(Lnghwnd,  0 )  'GW_HWNDFIRST)
 
Do Until LngResult =  0 
If IsWindowVisible(LngResult) Then
StrAppName = GetAppName(LngResult)
StrAppName = RTrim(Left(StrAppName, InStr( 1 , StrAppName, " ")))
If InStr( 1 , StrAppName, StrAppCaption) Then
LngICount = LngICount +  1 
End If
End If
LngResult = GetWindow(LngResult,  2 )  'GW_HWNDNEXT)
 
Loop
GetCountOfWindows = LngICount
End Function

Public Function Instance_Open()
Dim dbs As Database
Set dbs = CurrentDb
Application.GetOption ("Project Name")
If GetCountOfWindows(hWndAccessApp, Application.GetOption("Project Name")) >  0  Then
MsgBox "Эта программа уже открыта на вашем компьютере !!!"
Application.Quit acQuitSaveNone
End If
End Function