clsApp: My Application-Wide MS Access Singleton Class Module

I use many class modules in my applications, but this is the one I cannot live without.

clsApp: My Application-Wide MS Access Singleton Class Module

Every Microsoft Access application I write includes a class module named clsApp.

I've written several articles about the properties and methods that comprise this class:

As I write additional articles, I will update the list above and the code below accordingly.


There are two ways to use this class:

  • Via a global object variable declared in a standard module: Public App As New clsApp
  • By naming the class App and setting its hidden PredeclaredID attribute to True

In my own code, I use the first method.  However, that's mostly for backwards compatibility and consistency with my own codebase.  I was not aware of the PredeclaredID approach when I first started using clsApp.  By the time I realized it was an option, I had no desire to change all my existing code (or use two different approaches across my codebase).  

Additionally, the PredeclaredID approach looks a bit like magic to unsuspecting developers, since the attribute itself is completely hidden in the VBA IDE.


  • Throw(): raise custom errors with auto-generated deterministic error numbers

The Code

'--== clsApp class module ==--
Option Explicit
Option Compare Database

'RegisterTempFile() declarations:
Private m_collTempFiles As Collection

'Environment() declarations:
Public Enum env__Environment
End Enum

Private m_objDB As DAO.Database
Private m_sPgmName As String

'.Echo property declaration:
Private m_bEcho As Boolean

' Purpose   : Register a temporary file for cleanup.
' Source    :
' Notes     - The full path to the file must be passed to avoid accidentally deleting the wrong thing.
'           - These files are cleaned up when this class Terminates, usually at program exit.
'           - Changing data sources will also force a cleanup, because clsApp gets re-instantiated.
Public Sub RegisterTempFile(fpTempFile As String, Optional IgnoreTempFolderCheck As Boolean = False)
    'Validate the data
    If Len(fpTempFile) = 0 Then Exit Sub

    Dim IsFullPath As Boolean
    IsFullPath = (Left(fpTempFile, 2) = "\\") Or (Mid(fpTempFile, 2, 2) = ":\")
    If Not IsFullPath Then Throw "Not a full path: {0}", fpTempFile

    If IsDev() And Not IgnoreTempFolderCheck Then
        'File should be in the temp folder
        Dim IsInTempFolder As Boolean
        Dim foTemp As String  'temp folder
        foTemp = Environ("TEMP")
        IsInTempFolder = fpTempFile Like foTemp & "*"
        If Not IsInTempFolder Then Throw "Temporary files, like {0}, should be saved in the temporary folder: {1}", fpTempFile, foTemp
    End If

    If m_collTempFiles Is Nothing Then Set m_collTempFiles = New Collection

    m_collTempFiles.Add fpTempFile
End Sub

' Purpose   : Removes temporary files created by this program and registered via RegisterTempFile.
Private Function DeleteTempFiles()
    On Error Resume Next
    Dim fpTempFile As Variant
    For Each fpTempFile In m_collTempFiles
        'Extra safeguard to help prevent catastrophe
        Dim HasWildcard As Boolean
        HasWildcard = (InStr(fpTempFile, "*") > 0) Or _
                      (InStr(fpTempFile, "?") > 0)
        If Not HasWildcard Then
            SetAttr fpTempFile, vbNormal  'Remove read-only attribute if it is set
            Kill fpTempFile
        End If
    Next fpTempFile
End Function

' Procedure : Environment
' Author    : Mike Wolfe
' Source    :
' Date      : 6/27/2016
' Purpose   : Returns the current environment within which the application is operating.
' Usage     : If App.IsDev Then Debug.Assert LongRunningAssertionTest()
' Notes     - Always returns env_Production unless another environment explicitly set
'           - Settings are by user profile (and, thus, by machine)
'           - On a dev machine, need to call App.Environment = env_Development to get IsDev to return True
'           - Above call can be made from immediate window
'           - Testing fixtures should set App.Environment = env_Test at setup and revert at teardown
'           - Allows, for example, to replace objects with mocks in testing, such as a global logging object
'           - Using the registry means:
'                   o we can force non-Prod environment on users' computers, if we need to
'                   o its less likely to return a false positive than if we used user names or computer names to detect
'                   o is quick and easy to set the environment for developers on any computer
'                   o only needs to be set once per app per profile, not at every startup
'                   o survives code resets when programming state is lost (as opposed to using global vars, etc.)
Public Property Get Environment() As env__Environment
    Dim EnvAsString As String
    EnvAsString = GetSetting(Me.PgmName, "App", "Environment", "Prod")
    'Unless the user's registry is explicitly set to Dev or Test, assume Production
    Select Case EnvAsString
    Case "Dev": Environment = env_Development
    Case "Test": Environment = env_Test
    Case Else: Environment = env_Production
    End Select
End Property
Public Property Let Environment(Value As env__Environment)
    If Value = env_UNSET Then
        DeleteSetting Me.PgmName, "App", "Environment"
        SaveSetting Me.PgmName, "App", "Environment", EnvToString(Value)
    End If
End Property
Private Function EnvToString(Env As env__Environment) As String
    Select Case Env
    Case env_Development: EnvToString = "Dev"
    Case env_Production: EnvToString = "Prod"
    Case env_Test: EnvToString = "Test"
    End Select
End Function
Public Function IsDev() As Boolean
    IsDev = (Me.Environment = env_Development)
End Function
Public Function IsTest() As Boolean
    IsTest = (Me.Environment = env_Test)
End Function
Public Function IsProd() As Boolean
    IsProd = (Me.Environment = env_Production)
End Function

Public Property Get db() As Database
    Set db = m_objDB
End Property

Public Property Get PgmName() As String
    PgmName = m_sPgmName
End Property
Public Property Let PgmName(Value As String)
    m_sPgmName = Value
    Prop("PgmName") = Value
End Property

'Source :
'Purpose: Retrieves a property value stored in the front-end database itself.
'Notes  - If the property has not been set, the DefaultValue is returned instead
'       - However, if no DefaultValue is set either, an error is raised (3270: Property not found)
'       - There are certain property names with special meaning that should not be used for other purposes
'         Reserved property names:
'           - PgmName: the friendly name of the program; if not set, the front-end's filename without extension is used
'           - hg_csv: comma delimited list of tables whose data should be exported by decompose.vbs
Public Property Get Prop(PropName As String, Optional DefaultValue As String = "") As String
    If Len(DefaultValue) > 0 Then
        On Error Resume Next
        Prop = DefaultValue
    End If
    Prop = m_objDB.Properties(PropName)
End Property

Public Property Let Prop(PropName As String, Optional DefaultValue As String = "", ByVal sProp As String)
Dim P As DAO.Property

    On Error Resume Next
    m_objDB.Properties(PropName) = sProp
    If Err.Number = 3270 Then    'Property does not exist
        Set P = m_objDB.CreateProperty(PropName, dbText, sProp)
        db.Properties.Append P
    End If
End Property

'Source   :
Public Property Get Echo() As Boolean
    Echo = m_bEcho
End Property
Public Property Let Echo(ByVal bEcho As Boolean)
    Application.Echo bEcho
    m_bEcho = bEcho
End Property

'Source   :
Public Property Get TitleBar() As String
    TitleBar = Me.Prop("AppTitle", "Microsoft Access")
End Property
Public Property Let TitleBar(ByVal sTitleBar As String)
    Me.Prop("AppTitle") = sTitleBar
End Property

Private Sub Class_Initialize()
    Set m_objDB = CurrentDb

    Application.Echo True
    m_bEcho = True
    Dim DefaultPgmName As String
    DefaultPgmName = Application.CurrentProject.Name
    DefaultPgmName = Left(DefaultPgmName, InStr(DefaultPgmName, ".") - 1)
    m_sPgmName = Prop("PgmName", DefaultPgmName)
End Sub    

Private Sub Class_Terminate()
    Set m_objDB = Nothing
    'Remove temp files tracked via RegisterTempFile
    If Not m_collTempFiles Is Nothing Then DeleteTempFiles
End Sub

Referenced articles

VBA Alchemy: Turning Methods Into Properties
One can check the status of screen painting in Excel, but not in Access. This turns out to be an important shortcoming. Let’s remedy it.
Database Properties for Thee
The DAO Database object has a Properties collection. You can read through the list of properties to extract saved database options. You can also add your own properties to the object.
Environmentally Friendly Access
Using the Windows Registry to manage Production, Development, and Testing environments in #VBA and #MSAccess.
Automatically Cleaning Up Temporary Files on Program Exit
A dead-simple way to clean up temporary files without having to worry about waiting until they are no longer in use.
3 Ways to Get and Set the TitleBar Text for an MS Access Application
Here are three ways to set the Application Title for an MS Access application. My preferred method allows getting and setting with a single line of code.

UPDATE [2022-07-12]: Added .TitleBar property with link to associated article.

All original code samples by Mike Wolfe are licensed under CC BY 4.0