Environmentally Friendly Access

Mike Wolfe -

Modern IDEs, like Visual Studio, allow developers to choose from multiple execution environments.  For example, a new project in Visual Studio is pre-configured with a Debug and a Release environment.  There is no such feature built in to VBA, so we have to roll our own solution.

The solution I came up with uses the user registry (HKCU) to set and restore the execution environment on a per-application basis.  This approach has several advantages:

  1. The environment is always assumed to be Production (i.e., Release), unless explicitly set otherwise.
  2. Each developer manages the environment on their own machine and profile.
  3. It is straightforward to temporarily change the environment to troubleshoot an application on an end user's system.
  4. An end user cannot accidentally change their environment.
  5. Changing the environment in one application does not affect the environment in other applications.
  6. It's easy to retrieve the current environment, which means we can temporarily switch to a different environment and then switch back to the original (e.g., when testing).
  7. Convenience functions, such as .IsDev(), make our code very readable.

Since this is an application-level setting, I include the feature in my global singleton class, clsApp.

The Key Bits

The following excerpt from the clsApp module will not compile on its own, but I want to highlight how the property works.

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"
    Else
        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

I'm using the handy GetSetting, SaveSetting, and DeleteSetting VBA functions which provide access to the following registry location:

Computer\HKEY_CURRENT_USER\Software\VB and VBA Program Settings

Sample usage

Let's say we have a database file named "Database1.accdb".  We copy the full clsApp excerpt from the code block at the bottom of this page and paste it into a class module named clsApp.  In the immediate window, we then run the following commands:

Set App = New clsApp

?App.IsDev, App.IsTest, App.IsProd
False         False         True

App.Environment = env_Test
?App.IsDev, App.IsTest, App.IsProd
False         True          False

App.Environment = env_Development
?App.IsDev, App.IsTest, App.IsProd
True          False         False

And here's what our registry looks like after executing these lines:

Use for testing

In an earlier article, I talked about how I implemented (quasi-)dependency injection in VBA.  In that article, I created separate routines to configure services for testing versus production.  With this approach, though, I could make the environment-dependent routines private, and have a single public routine to handle service configuration:

Public Sub ConfigureServices()
    Select Case App.Environment
    Case env_Test
        ConfigureServicesForTesting
    Case env_Prod, env_Dev
        ConfigureServices
    Case Else
        Throw "Unexpected App.Environment setting: {0}", App.Environment
    End Select
End Sub
See also: Throwing Errors in VBA and Defensive Programming

Use for debugging

One of the major drawbacks to VBA's built-in Debug.Assert method is that it evaluates its arguments even if it won't break into the code with a False result.  You can't even avoid this by compiling your front-end database into an .mde or .accde file.  The Debug.Assert arguments will always be evaluated.

This means that if I want to perform a computationally-expensive assertion in my code during development, there is no easy way to strip that out of the code that I ship to my end users.  What this approach allows me to do is use those kinds of assert statements during development without impacting my users in production.

If App.IsDev Then Debug.Assert ThisWillTakeAwhileButItBetterBeTrue()

The Code

The following is an excerpt from my Code Library's clsApp class module.  It is a fully functional implementation of my Environment-handling code: 

'--== excerpt from clsApp class module ==--
Public Enum env__Environment
    env_UNSET
    env_Development
    env_Test
    env_Production
End Enum

Private m_objDB As DAO.Database
Private m_sPgmName As String

'---------------------------------------------------------------------------------------
' Procedure : Environment
' Author    : Mike
' 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"
    Else
        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

'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
    m_objDB.Properties.Refresh
    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.Refresh
    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

Private Sub Class_Initialize()
    Set m_objDB = CurrentDb

    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
End Sub

Image by Bela Geletneky from Pixabay