Делимся наработками

'---------------------------------------------------------------------------------------
' Procedure : fnCloseAllOpenForms
' Author    : vlad469
' Date      : 20.03.2023
' Purpose   : Close all open Forms
'---------------------------------------------------------------------------------------
'
Public Function fnCloseAllOpenForms() As Boolean
 
    On Error GoTo fnCloseAllOpenForms_Error
   
    Dim dbs As Object
    Dim Obj As Object
    
    Set dbs = Application.CurrentProject
    For Each Obj In dbs.AllForms
        If Obj.IsLoaded = True Then DoCmd.Close acForm, Obj.Name
    Next Obj
        
    fnCloseAllOpenForms = True
 
   On Error GoTo 0
   Exit Function
 
fnCloseAllOpenForms_Error:
 
    MsgBox "Error " & err.Number & " (" & _
        err.Description & ") in procedure fnCloseAllOpenForms"
 
End Function

'---------------------------------------------------------------------------------------
' Procedure : CloseAllOpenTables
' Author    : Daniel Pineault, CARDA Consultants Inc.
' Website   : http://www.cardaconsultants.com
' Purpose   : Close all the currently open Tables in the database
' Copyright : The following is release as Attribution-ShareAlike 4.0 International
'             (CC BY-SA 4.0) - https://creativecommons.org/licenses/by-sa/4.0/
' Req'd Refs: None required
'
' Usage:
' ~~~~~~
' ? CloseAllOpenTables
'   Returns -> True     => Closed all Tables successfully
'              False    => A problem occurred
'
' Revision History:
' Rev       Date(yyyy/mm/dd)        Description
' **************************************************************************************
' 1         2015-02-17              Initial Release
' 2         2023-02-09              Update variable naming, Error handler, copyright
'---------------------------------------------------------------------------------------
Function CloseAllOpenTables() As Boolean
    On Error GoTo Error_Handler
    Dim oTbls                 As Object
    Dim oTbl                  As Access.AccessObject
 
    Set oTbls = CurrentData.AllTables
 
    For Each oTbl In oTbls    'Loop all the tables
        If oTbl.IsLoaded = True Then 'check if it is open
            DoCmd.Close acTable, oTbl.Name, acSaveNo
        End If
    Next oTbl
    
    CloseAllOpenTables = True
 
Error_Handler_Exit:
    On Error Resume Next
    Set oTbl = Nothing
    Set oTbls = Nothing
    Exit Function
 
Error_Handler:
    MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
           "Error Source: CloseAllOpenTables" & vbCrLf & _
           "Error Number: " & Err.Number & vbCrLf & _
           "Error Description: " & Err.Description & _
           Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
           , vbOKOnly + vbCritical, "An Error has Occurred!"
    Resume Error_Handler_Exit
End Function

Call CloseAllOpenTables

If CloseAllOpenTables = True Then
    '...
End If

'---------------------------------------------------------------------------------------
' Procedure : CloseAllOpenQueries
' Author    : Daniel Pineault, CARDA Consultants Inc.
' Website   : http://www.cardaconsultants.com
' Purpose   : Close all the currently open Queries in the database
' Copyright : The following is release as Attribution-ShareAlike 4.0 International
'             (CC BY-SA 4.0) - https://creativecommons.org/licenses/by-sa/4.0/
' Req'd Refs: None required
'
' Usage:
' ~~~~~~
' ? CloseAllOpenQueries
'   Returns -> True     => Closed all Queries successfully
'              False    => A problem occurred
'
' Revision History:
' Rev       Date(yyyy/mm/dd)        Description
' **************************************************************************************
' 1         2015-02-17              Initial Release
' 2         2023-02-09              Update variable naming, Error handler, copyright
'---------------------------------------------------------------------------------------
Function CloseAllOpenQueries() As Boolean
    On Error GoTo Error_Handler
    Dim oQrys                 As Object
    Dim oQry                  As Access.AccessObject
 
    Set oQrys = CurrentData.AllQueries
 
    For Each oQry In oQrys    'Loop all the queries
        If oQry.IsLoaded = True Then 'check if it is open
            DoCmd.Close acQuery, oQry.Name, acSaveNo
        End If
    Next oQry
    
    CloseAllOpenQueries = True
 
Error_Handler_Exit:
    On Error Resume Next
    Set oQry = Nothing
    Set oQrys = Nothing
    Exit Function
 
Error_Handler:
    MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
           "Error Source: CloseAllOpenQueries" & vbCrLf & _
           "Error Number: " & Err.Number & vbCrLf & _
           "Error Description: " & Err.Description & _
           Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
           , vbOKOnly + vbCritical, "An Error has Occurred!"
    Resume Error_Handler_Exit
End Function

Call CloseAllOpenQueries

If CloseAllOpenQueries= True Then
    '...
End If

'---------------------------------------------------------------------------------------
' Procedure : CloseAllOpenMacros
' Author    : Daniel Pineault, CARDA Consultants Inc.
' Website   : http://www.cardaconsultants.com
' Purpose   : Close all the currently open Macros in the database
' Copyright : The following is release as Attribution-ShareAlike 4.0 International
'             (CC BY-SA 4.0) - https://creativecommons.org/licenses/by-sa/4.0/
' Req'd Refs: None required
'
' Usage:
' ~~~~~~
' ? CloseAllOpenMacros
'   Returns -> True     => Closed all Macros successfully
'              False    => A problem occurred
'
' Revision History:
' Rev       Date(yyyy/mm/dd)        Description
' **************************************************************************************
' 1         2015-02-17              Initial Release
' 2         2023-02-09              Update variable naming, Error handler, copyright
'---------------------------------------------------------------------------------------
Function CloseAllOpenMacros() As Boolean
    On Error GoTo Error_Handler
    Dim oMcrs                 As Object
    Dim oMcr                  As Access.AccessObject
 
    Set oMcrs = CurrentProject.AllMacros
 
    For Each oMcr In oMcrs    'Loop all the queries
        If oMcr.IsLoaded = True Then    'check if it is open
            DoCmd.Close acMacro, oMcr.Name, acSaveNo
        End If
    Next oMcr
 
    CloseAllOpenMacros = True
 
Error_Handler_Exit:
    On Error Resume Next
    Set oMcr = Nothing
    Set oMcr = Nothing
    Exit Function
 
Error_Handler:
    MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
           "Error Source: CloseAllOpenMacros" & vbCrLf & _
           "Error Number: " & Err.Number & vbCrLf & _
           "Error Description: " & Err.Description & _
           Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
           , vbOKOnly + vbCritical, "An Error has Occurred!"
    Resume Error_Handler_Exit
End Function

Call CloseAllOpenMacros

If CloseAllOpenMacros = True Then
    '...
End If