Re: Multiple Instance of a form limite

G,
I dont know about your second question, but I had to do the opposite of
the first to keep a user from opening two instances of a database. The
solution should work for you with modification. It's a little on the
hacky side, but hey. :) For forms, EnumChildWindows might work better
for you.
Have fun

Declare Function GetWindowText Lib "user32" Alias _
"GetWindowTextA" _
(ByVal hWnd As Long, _
ByVal lpString As String, _
ByVal cch As Long) As Long

Private Declare Function EnumWindows Lib "user32" (ByVal lpEnumFunc As
Long, ByVal lParam As Long) As Long
Private Declare Function SetForegroundWindow Lib "user32" (ByVal hWnd
As Long) As Long

Private byDatabasesOpen As Byte 'The number of instances of
this db open on this machine
Private strAppTitle As String 'The title of this
DB
Private hOtherOpenApp As Long 'handle of the other open
db if there is one

Public Function TestForInstances() As Boolean
'*************************************************************************
' Author Daniel Tweddell
' Date 12/05/02
' Revision
'
' Tests to see if other instances of this database are already open.
If so
' we switch to the other and close this one.
' returns true if there is another instance
'*************************************************************************
If Not bShowDebug Then On Error GoTo Err_Function
byDatabasesOpen = 0
Dim strName As String * 255
GetWindowText Application.hWndAccessApp, strName, 255 'get this
dbs name
strAppTitle = Trim(strName)
EnumWindows AddressOf WndEnumProc, 0
If byDatabasesOpen Then 'will
register as true if > 0
SetForegroundWindow hOtherOpenApp 'focus on
the open db
TestForInstances = True
End If
Exit Function
Err_Function:
errHandler Err.Number, Err.Description, "TestForInstances()",
bSilent
End Function

Public Function WndEnumProc(ByVal hWnd As Long, ByVal lParam As Long)
As Long
'*************************************************************************
' Author Daniel Tweddell
' Date 12/05/02
' Revision
'
' callback for the EnumWindows api. Tests the existing windows against
' this one and returns a handle and a count of same named dbs
'*************************************************************************
If Not bShowDebug Then On Error GoTo Err_Function
Const iSuccess As Integer = 1
Dim strName As String * 255
Dim lSuccess As Long
lSuccess = GetWindowText(hWnd, strName, 255) 'get the name
of the window
If lSuccess <> 0 Then 'see if got
anything
If strAppTitle = Trim(strName) Then 'test it
against our window's name
If hWnd <> Application.hWndAccessApp Then 'make sure it's
not our app
byDatabasesOpen = byDatabasesOpen + 1 'count
hOtherOpenApp = hWnd 'get the other
app's handle
End If
End If
End If
WndEnumProc = iSuccess
Exit Function
Err_Function:
errHandler Err.Number, Err.Description, "WndEnumProc()"
End Function

.

Relevant Pages

  • Re: Sendmessage using dot net
    ... (ByVal hwnd As IntPtr, ByVal wMsg As Integer, ByVal wParam As Integer, _ ... ByVal lParam As String) As Integer ... Dim nSize As Integer ... Private Declare Function GetDesktopWindow Lib "user32" As Long ...
    (microsoft.public.dotnet.languages.vb)
  • Re: Using Hyperlinks within Userforms
    ... (ByVal hWnd As Long, _ ... ByVal lpOperation As String, _ ... Public Sub OpenFile ... Const HWND_NOTOPMOST = -2 ...
    (microsoft.public.excel)
  • Re: Referencing subform during module code
    ... This would work at the form level, but not at the subform. ... Dim strName As String ...
    (comp.databases.ms-access)
  • Re: Check for table name
    ... Function TableExists(TableName As String) As Boolean ... Dim strName As String ... Doug Steele, Microsoft Access MVP ...
    (microsoft.public.access.formscoding)
  • Userform ohne schliessen Kreuz mit Logo
    ... "FindWindowA" (ByVal lpClassName As String, ByVal _ lpWindowName As String) As Long ... "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex _ As Long, ByVal dwNewLong As Long) As Long ... wHandle = FindWindow ...
    (microsoft.public.de.excel)