Article ID: 101312
Article Last Modified on 5/6/2003
'*****************************************************************
' DECLARATION SECTION
'*****************************************************************
Option Explicit
'*****************************************************************
' FUNCTION: OpenFormInstance()
'
' PURPOSE:
' Allows you to open more than one copy of the same form
' on screen at a time.
'
' PREREQUISITES:
' You must make X number of copies of the the
' form, renaming them with a numeric suffix greater than zero.
' Example:
'
' "Customers1," "Customers2," "Customers3," ...
'
' REQUIRES:
' Function IsLoaded() - Determines if form is loaded.
' Function GetFormNames() - Supplied in this module.
'
' ARGUMENTS:
' FormName - The generic name of the form to open.
' Example:
'
' "Customers"
'
' RETURNS:
' True - if an instance of FormName was opened.
' False - if no instance of FormName was found or all available
' instances are active.
'
' NOTES:
' You can customize the OpenForm action in the code below to add
' additional (optional) parameters, such as a Where condition or
' or alternate view.
'
'********************************************************************
Function OpenFormInstance (ByVal FormName As String)
Dim Count, i, Msg As String, InstanceCount
ReDim Names(0) As String
' Get a list of all the forms in the current database.
Count = GetFormNames(Names())
' Loop through the list of forms for a match with
' .. the requested form.
For i = 0 To Count - 1
' Is the name of the form, minus the suffix, the same?
If FormName = Left(Names(i), Len(FormName)) Then
' .. is the suffix a number greater than zero?
If Val(Mid(Names(i), Len(FormName) + 1)) > 0 Then
' Count the number of instances.
InstanceCount = InstanceCount + 1
' If the form is NOT loaded,load it.
If Not IsLoaded(Names(i)) Then
DoCmd OpenForm Names(i)
OpenFormInstance = True
Exit Function
End If
End If
End If
Next i
' No form was found or all instances are being used.
OpenFormInstance = False
' If no instance was found, just return.
If InstanceCount = 0 Then Exit Function
' If all instances are being used, display error message.
Msg = "Couldn't open form """ & FormName & """."
Msg = Msg & Chr$(13) & Chr$(13)
Msg = Msg & "Please close another instance and try again."
MsgBox Msg, 48
End Function
'****************************************************************
' FUNCTION: GetFormNames()
'
' PURPOSE:
' Fills the string array with a list of forms names.
'
' ARGUMENTS:
' Names - A single dimensional array of type string.
'
' RETURN:
' The number(zero based) of names stored in the Names array.
'
' NOTES:
' This function uses information stored in the
' MySysObject table of the currently opened database.
' The system tables are undocumented and are subject to
' change in future versions of Microsoft Access.
'
'****************************************************************
Function GetFormNames (Names() As String)
Dim db As Database, ss As Snapshot
Dim Count, SQL
Dim Msg As String
SQL = "Select Name,Type from MSysObjects Where Type="
SQL = SQL & "-32768 And Left(Name,1)<>'~' Order By Name;"
Set db = CurrentDB()
Set ss = db.CreateSnapshot(SQL)
ss.MoveLast
If ss.RecordCount > 0 Then
ReDim Names(0 To ss.RecordCount - 1)
Else
GetFormNames = 0
Exit Function
End If
ss.MoveFirst
Count = 0
Do While Not ss.EOF
Names(Count) = ss![name]
Count = Count + 1
ss.MoveNext
Loop
GetFormNames = ss.RecordCount
End Function
MsgBox Screen.ActiveForm![ControlName]
Function MyFunction(MyForm)
MsgBox Forms(MyForm)![ControlName]
End Function
RunCode
Function Name: =MyFunction(Screen.ActiveForm.FormName)
Additional query words: open twice isloaded running
Keywords: kbfix kbprb kbusage KB101312