Option Compare Database
Option Explicit
Public mcolFormInstances As New Collection
Public Function CheckForFormInstance(strFormName As String, Optional strFilter As String) As Form
On Error GoTo Err_Handler
Dim i As Integer
Set CheckForFormInstance = Form_Empty
For i = 1 To mcolFormInstances.Count
If mcolFormInstances(i).Name = strFormName Then
If mcolFormInstances(i).Filter = strFilter Then
Set CheckForFormInstance = mcolFormInstances(i)
GoTo Code_Exit
Else
Select Case strFormName
Case "frmStudentList"
Set CheckForFormInstance = mcolFormInstances(i)
GoTo Code_Exit
End Select
End If
End If
Next_Loop:
If i = mcolFormInstances.Count Then
Exit For
End If
Next i
Code_Exit:
Exit Function
Err_Handler:
If Err.Number = 2467 Then ' object is broken
mcolFormInstances.Remove i
i = i - 1
GoTo Next_Loop
End If
DisplayUnexpectedError Err.Number, Err.Description
Resume Code_Exit
'Resume Next
End Function
Public Sub CloseFormInstance(frm As Form)
On Error GoTo Err_Handler
mcolFormInstances.Remove CStr(frm.Hwnd)
Code_Exit:
Set frm = Nothing
Exit Sub
Err_Handler:
If Err.Number = 5 Then ' the hWnd key doesn't exist in mcolFormInstances
Resume Code_Exit
End If
DisplayUnexpectedError Err.Number, Err.Description
Resume Code_Exit
'Resume Next
End Sub
Public Function OpenFormInstance(strFormName As String, Optional strFilter As String) As Form
On Error GoTo Err_Handler
Dim frm As Form
Dim mdl As Module
Set frm = CheckForFormInstance(strFormName, strFilter)
If frm Is Form_Empty Then
' THIS IS THE PART - START
Select Case strFormName
Case "frmStudAgenda"
Set frm = New Form_frmStudAgenda
Case "frmStudentList"
Set frm = New Form_frmStudentList
Case "frmStudInfo"
Set frm = New Form_frmStudInfo
Case "frmStudRecords"
Set frm = New Form_frmStudRecords
Case "frmUnitInfo"
Set frm = New Form_frmUnitInfo
Case Else
DoCmd.OpenForm strFormName, , , strFilter
GoTo Code_Exit
End Select
' THIS IS THE PART - END
If strFilter <> "" Then
frm.Filter = strFilter
frm.FilterOn = True
End If
mcolFormInstances.Add Item:=frm, Key:=CStr(frm.Hwnd)
frm.Visible = True
Else
frm.Visible = True
frm.SetFocus
End If
Code_Exit:
Set OpenFormInstance = frm
Set frm = Nothing
Exit Function
Err_Handler:
DisplayUnexpectedError Err.Number, Err.Description
Resume Code_Exit
'Resume Next
End Function