Here's a few functions I've come across for various form
evaluation/manipulation, they might be of some interest...
Public Function IsFormOpen(ByVal fName As String) As Boolean
Dim bExists As Boolean
Dim frm As Form
For Each frm In Forms
If UCase(fName) = UCase(frm.Name) Then
bExists = True
Exit For
End If
Next
IsFormOpen = bExists
End Function
Public Function CloseAllForms(Optional strExceptions As String = "F1;F2") As
Boolea
'
http://www.utteraccess.com/forums/showflat.php?Cat=&Board=84&Number=1734199&Zf=&Z
'=close%20all%20forms&Zg=1&Zl=a&Main=1734199&Search=true&where=&Zu=&Zd=g&Zn=&Zt=44&
'Zs=a&Zy=
'
'Close Open Forms except those passed in argument, semi-colon delimited.
'InStr test below includes Semi-Colons so to prevent leaving open a form
'with a partiallly matching form name.
On Error GoTo CloseAllForms_Error
Dim obj As Object
Dim strName As String
CloseAllForms = True
If Left(strExceptions, 1) <> ";" Then strExceptions = ";" & strExceptions
If Right(strExceptions, 1) <> ";" Then strExceptions = strExceptions & ";"
For Each obj In Application.CurrentProject.AllForms
If InStr(strExceptions, ";" & obj.Name & ";") = 0 Then
DoCmd.Close acForm, obj.Name
End If
Next obj
CloseAllForms_Exit:
Exit Function
CloseAllForms_Error:
CloseAllForms = False
xHandler Err.Number, Err.Description, _
"mod_System", "CloseAllForms"
Resume CloseAllForms_Exit
Resume
End Function
'==============================================================================
' Returns True if the specified forms are open
' ARGUMENTS:
' Optional aExceptions: string of exceptions, semicolon delimite
'==============================================================================
'ErrStrV1.50
Public Function CheckForOpenForms( _
Optional aExceptions As String = "") As Boolean
On Error GoTo Error_CheckForOpenForms
Dim bRet As Boolean
bRet = False
'===================
Dim obj As Object
Dim iCount As Integer
'===================
'Initialize
If Left(aExceptions, 1) <> ";" Then aExceptions = ";" & aExceptions
If Right(aExceptions, 1) <> ";" Then aExceptions = aExceptions & ";"
iCount = 0
For Each obj In Application.CurrentProject.AllForms
If (InStr(1, aExceptions, ";" & obj.Name & ";") = 0) Then
iCount = IIf(IsFormOpen(obj.Name) = True, iCount + 1, iCount)
End If
Next obj
bRet = IIf(iCount = 0, False, True)
'===================
Exit_CheckForOpenForms:
CheckForOpenForms = bRet
Exit Function
Error_CheckForOpenForms:
Dim xM As String: xM = ""
Dim xB As Long: xB = 16
Dim xT As String: xT = "Error"
Dim xS As Boolean: xS = True
Dim xE As Long: xE = 0
xHandler Err.Number, Err.Description, _
"mod_sObjOps", "CheckForOpenForms", xM, xB, xT, xS, xE
Resume Exit_CheckForOpenForms
Resume
End Function
IsFormOpen I'm not sure where it came from.... I got it a while ago from
somewhere but apparently didn't take any information with it.
CloseAllForms: credit given through the link at the top
CheckForOpenForms: I modified CloseAllForms to check to see if any are open.
Useful for user prompt conditional on a logout
You'll have to edit the error handling, everything should be ready to run.
--
Jack Leach
www.tristatemachine.com
- "First, get your information. Then, you can distort it at your leisure."
- Mark Twain
