VBA - Parsed JSON as application state - Simple Guest House Room Reservation

Continuing the theme of mutable JSON documents, here in this post I illustrate how we can start to build an application that stores its state in a JSON document. One envisages this as the client side logic and when ready to save to a database one posts the new document to a web service that can either save the whole document to MongoDb or shred the details into tables on a relational database.

The application given below is a very simple room reservation program for a small guest house we three bedrooms. There is a customers collection, a rooms collection and a bookings collection. A booking has a 'foreign key' to both the customer and the room.

There is a test sub at the end TestAddCustomerAndBookings() which adds two customers and two room bookings and then prints out the JSON document after its modifications.

{
  "Customers": [
    {
      "lCustomerId": "1",
      "sName": "Mr White",
      "sAddress": "London"
    },
    {
      "lCustomerId": "2",
      "sName": "Mr Blue",
      "sAddress": "Ohio"
    }
  ],
  "Rooms": [
    {
      "lRoomId": 1,
      "sleeps": 1
    },
    {
      "lRoomId": 2,
      "sleeps": 2
    },
    {
      "lRoomId": 3,
      "sleeps": 3
    }
  ],
  "Bookings": [
    {
      "lBookingId": "1",
      "lCustomerId": "1",
      "lRoomId": "1",
      "dtFirstNight": "25/12/2018",
      "dtLastNight": "02/01/2019"
    },
    {
      "lBookingId": "2",
      "lCustomerId": "2",
      "lRoomId": "3",
      "dtFirstNight": "02/02/2018",
      "dtLastNight": "06/02/2018"
    }
  ]
}

Here is the code listing

Option Explicit

'* Tools->References
' MSScriptControl      Microsoft Script Control 1.0    C:\Windows\SysWOW64\msscript.ocx
' Scripting            Microsoft Scripting Runtime     C:\Windows\SysWOW64\scrrun.dll
' MSXML2               Microsoft XML, v6.0             C:\Windows\SysWOW64\msxml6.dll

Private mfso As New Scripting.FileSystemObject

Private moRoot As Object

Private Function SC() As ScriptControl
    Static soSC As ScriptControl
    If soSC Is Nothing Then

        Set soSC = New ScriptControl
        soSC.Language = "JScript"

        soSC.AddCode "function deleteValueByKey(obj,keyName) { delete obj[keyName]; } "
        soSC.AddCode "function setValueByKey(obj,keyName, newValue) { obj[keyName]=newValue; } "
        soSC.AddCode "function enumKeysToMsDict(jsonObj,msDict) { for (var i in jsonObj) { msDict.Add(i,0); }  } "
        soSC.AddCode GetJavaScriptLibrary("https://raw.githubusercontent.com/douglascrockford/JSON-js/master/json2.js")
        soSC.AddCode "function JSON_stringify(value, replacer,spacer) { return JSON.stringify(value, replacer,spacer); } "
        soSC.AddCode "function JSON_parse(sJson) { return JSON.parse(sJson); } "

    End If
    Set SC = soSC
End Function

Private Function GetJavaScriptLibrary(ByVal sURL As String) As String

    Dim xHTTPRequest As MSXML2.XMLHTTP60
    Set xHTTPRequest = New MSXML2.XMLHTTP60
    xHTTPRequest.Open "GET", sURL, False
    xHTTPRequest.send
    GetJavaScriptLibrary = xHTTPRequest.responseText

End Function

Private Function DefaultApplicationState() As Object
    Const sDefaultApplicationState As String = "{""Customers"":[], " & _
        """Rooms"":[{""lRoomId"":1,""sleeps"":1},{""lRoomId"":2,""sleeps"":2}," & _
        "{""lRoomId"":3,""sleeps"":3}], " & _
        """Bookings"": []}"
    
    Set DefaultApplicationState = SC.Run("JSON_parse", sDefaultApplicationState)
    
End Function


Private Function AddRoomBooking(ByVal lCustomerId As Long, ByVal lRoomId As Long, ByVal dtFirstNight As Date, ByVal dtLastNight As Date) As Long

    Dim objBookings As Object
    Set objBookings = CallByName(moRoot, "Bookings", VbGet)
    
    Dim lBookingId As Long
    lBookingId = CallByName(objBookings, "length", VbGet) + 1
    
    'TODO write logic to avoid double-booking
    
    Dim objNewBooking As Object
    Set objNewBooking = SC.Run("JSON_parse", "{ ""lBookingId"":""" & lBookingId & """, ""lCustomerId"":""" & lCustomerId & """," & _
            """lRoomId"":""" & lRoomId & """,""dtFirstNight"":""" & dtFirstNight & """,""dtLastNight"":""" & dtLastNight & """}")
    
    Call CallByName(objBookings, "push", VbMethod, objNewBooking)
    
    AddRoomBooking = lBookingId
End Function


Private Function AddCustomer(ByVal sName As String, ByVal sAddress As String) As Long
    Dim objCustomers As Object
    Set objCustomers = CallByName(moRoot, "Customers", VbGet)
    
    '* TODO fins unique id for each
    Dim lCustomerId As Long
    lCustomerId = CallByName(objCustomers, "length", VbGet) + 1
    
    Dim objNewCustomer As Object
    Set objNewCustomer = SC.Run("JSON_parse", "{ ""lCustomerId"":""" & lCustomerId & """, " & _
                        """sName"":""" & sName & """,""sAddress"":""" & sAddress & """}")
    
    Call CallByName(objCustomers, "push", VbMethod, objNewCustomer)
    
    AddCustomer = lCustomerId
End Function

Private Sub TestAddCustomerAndBookings()
    'End
    Set moRoot = DefaultApplicationState
    
    Dim lCustomerId As Long
    lCustomerId = AddCustomer("Mr White", "London")
    AddRoomBooking lCustomerId, 1, #12/25/2018#, #1/2/2019#
    
    lCustomerId = AddCustomer("Mr Blue", "Ohio")
    AddRoomBooking lCustomerId, 3, #2/2/2018#, #2/6/2018#
    
    Dim sAppStateSavePoint As String
    sAppStateSavePoint = SC.Run("JSON_stringify", moRoot, Null, 2)
    
    Debug.Print "'*TODO save either (a) as whole document to MondgoDb"
    Debug.Print "'* or (b) shred into tables on relational database"
    Debug.Print sAppStateSavePoint
    
End Sub

VBA - Use RAII Design Pattern to tidy your code managing Excel's Status Bar

Summary: Use classes to manage Application state such as Application.StatusBar, Application.DisplayAlerts, Application.ScreenUpdating and Application.EnableEvents.

In this inaugural post we'll start simple with my favourite tip, using RAII design pattern

When working with Excel one will manipulate the Application.StatusBar to convey information to the user.  However, different subroutines may want to convey different information so either they must co-operate with each implementing its own save restore mechanism or alternatively we can use a class.

RAII stands for Resource Acquisition Is Initialization , don't worry it's just a fancy name for a simple technique.  When a class is instantiated its constructor is called and if the reference is stored in a local variable then when the code leaves the scope and is destroyed then the class's destructor is called.

Before we get to the best answer, let's show the less optimal answer.  In the following code, we see that each subroutine implements its own save and restore mechanism to help jointly manage the status bar.  If the status bar is showing the default text, usually "Ready" then capturing this value returns "FALSE".  To reset the status bar we call Application.StatusBar = False.  To set to anything else we just supply the string.  So in the code below the status bar's value is captured upon entering

'Module1.bas
Option Explicit

Sub A()
    Dim vSBSaved As Variant
    vSBSaved = Application.StatusBar

    Application.StatusBar = "Entered A"
    B
    
    
RestoreStatusBar:
    If vSBSaved = "FALSE" Then Application.StatusBar = False Else _
        Application.StatusBar = vSBSaved
    
End Sub

Sub B()
    Dim vSBSaved As Variant
    vSBSaved = Application.StatusBar
    
    Application.StatusBar = "Entered B"
    
RestoreStatusBar:
    If vSBSaved = "FALSE" Then Application.StatusBar = False Else _
        Application.StatusBar = vSBSaved
End Sub

Clearly nobody wants to repeat this code and some of it could be factored out into separate routines.  However, matters get complicated if one starts using Goto such as On Error Goto ErrorHandler and then one will have to jump around to the RestoreStatusBar label.   I'll spare you that bad example, instead let me show you a RAII solution.

'RAIIStatusBar.cls
Option Explicit

Dim vSBSaved As Variant

Sub Class_Initialize()
    vSBSaved = Application.StatusBar
End Sub

Private Sub Class_Terminate()
    If vSBSaved = "FALSE" Then Application.StatusBar = False _
        Else Application.StatusBar = vSBSaved
End Sub

In the above class, we have housed the save and restore code. In Excel VBA instead of constructors and destructors we have the Class_Initialize and Class_Terminate events respectively.  Now it is simple to use this class in your normal code.

'Module2.bas
Option Explicit

Sub A()
    Dim oSB As RAIIStatusBar
    Set oSB = New RAIIStatusBar

    Application.StatusBar = "Entered A"
    B
End Sub '* When oSB goes out of scope status bar is restored to "Ready"

Sub B()
    Dim oSB As RAIIStatusBar
    Set oSB = New RAIIStatusBar
    Application.StatusBar = "Entered B"
End Sub '* When oSB goes out of scope status bar is restored to "Entered A"

Feel free to step through the code so that you understand the sequence of events. This is a powerful technique known to any object orientated programmer working in C++,Java or C#. We can use it in VBA as well.

Can this used for other Application settings? Yes but the Status Bar is a special case because the setting is a string. The other Application states you'd probably handle are simply Booleans.

I give a class now for the Boolean Application.ScreenUpdating and it would be easy to copy across for the other Booleans Application.EnableEvents and Application.DisplayAlerts .

'RAIIScreenUpdating.cls
Option Explicit

Dim bSUSaved As Boolean

Sub Class_Initialize()
    bSUSaved = Application.ScreenUpdating
End Sub

Private Sub Class_Terminate()
    Application.ScreenUpdating = bSUSaved
End Sub

for It is possible to use this pattern to write similar classes for the great many of use cases where a setting has to be saved and restored, such Application.ScreenUpdating, Application.EnableEvents and Application.DisplayAlerts and I give a simple class for ScreenUpdating it would be easy to copy across for the others.