VBA - Bang Syntax Part2 - JSON Parsing Revisited (again!)

Plenty of JSON parsing posts on this blog and here I return again to the subject.

I was so hopefuil when I discovered the ScriptControl and its ability to return parsed JSON, one could use the dot notation to traverse the hierarchy if it weren't for VBA amending casing, see this SO question for a complete example of this pain. The answer then was to use CallByName and that still is the answer but we can use the bang ! syntax where the dots used to be using the following code.

First, let me show you the client code to whet your appetite. Q. How does this solves the casing issue? A. Because the text to the right of the bang ! is treated as a string to be passed to the default member (which I will show you how to setup shortly).

Sub Test()

    Dim oJSONParser As JSONParser
    Set oJSONParser = New JSONParser
    
    Dim sJSON As String
    sJSON = VBA.Replace("{ 'name':'John', 'age':30, 'cars':{ 'car1':'Ford','car2':'BMW','car3':'Fiat'} }", "'", """")
    
    Dim oJSONBang As JSONBang
    Set oJSONBang = oJSONParser.DecodeJsonString(sJSON)

    Dim oCars As JSONBang
    Set oCars = oJSONBang!cars  ' drill into cars property
    
    Dim sCar2 As String
    sCar2 = oCars!car2     ' drill into car2 property
    
    '* or use chain syntax
    sCar2 = oJSONBang!cars!car2
    

    Stop

End Sub

Ok so there are two classes, JSONParser and JSONBang, the former houses the parser logic whilst the latter represents each segment.

JSONParser class

So this parser class uses the Microsoft Script Control but uses a downloaded script authored by Douglas Crockford that parses JSON to an object. Please use Douglas's script and please DO NOT USE EVAL. I have also added a ToString override helper function.

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "JSONParser"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
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 Function SC() As ScriptControl
    Static soSC As ScriptControl
    If soSC Is Nothing Then

        Set soSC = New ScriptControl
        soSC.Language = "JScript"
        
        '* https://stackoverflow.com/questions/45015/safely-turning-a-json-string-into-an-object
        soSC.AddCode GetJavaScriptLibrary("https://raw.githubusercontent.com/douglascrockford/JSON-js/master/json2.js")
        soSC.AddCode "function JSON_parse(sJson) { return JSON.parse(sJson); } "
        soSC.AddCode "function overrideToString(jsonObj) { jsonObj.toString = function() { return JSON.stringify(this); } }"

    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

Public Function DecodeJsonString(ByVal JsonString As String) As JSONBang
    Dim oSC As ScriptControl
    Set oSC = SC

    Dim obj As Object
    Set obj = oSC.Run("JSON_parse", JsonString)

    Call oSC.Run("overrideToString", obj) '* this gives JSON rendering instead of "[object Object]"

    Set DecodeJsonString = New JSONBang
    Set DecodeJsonString.JScriptTypeInfo = obj

End Function

JSONBang class

So this JSONBang class has the Item method annotated with Attribute Item.VB_UserMemId = 0 so it becomes the default method and that way we can use bang ! because it looks for a default method with a single parameter and passes that to the right of the bang as the parameter.

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "JSONBang"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Private mobjJScriptTypeInfo As Object

Public Property Set JScriptTypeInfo(rhs As Object)
    If TypeName(rhs) = "JScriptTypeInfo" Then
        Set mobjJScriptTypeInfo = rhs
    Else
        Err.Raise 13
    End If
End Property

Public Property Get JScriptTypeInfo() As Object
    Set JScriptTypeInfo = mobjJScriptTypeInfo
End Property

Public Function ToString() As String
    ToString = mobjJScriptTypeInfo
End Function

Public Function Item(Key)
Attribute Item.VB_UserMemId = 0
    
    'Attribute Item.VB_UserMemID = 0
    
    If mobjJScriptTypeInfo Is Nothing Then Err.Raise vbObjectError, "#base JSON class (JScriptTypeInfo) not yet!"
    
    If IsObject(CallByName(mobjJScriptTypeInfo, Key, VbGet)) Then
    
        Dim obj As Object
        Set obj = CallByName(mobjJScriptTypeInfo, Key, VbGet)
    
        Dim oRet As JSONBang
        Set oRet = New JSONBang
        Set oRet.JScriptTypeInfo = obj
        
        Set Item = oRet
    
    Else
        Dim vVar
        vVar = CallByName(mobjJScriptTypeInfo, Key, VbGet)
        Item = vVar
    End If
    

End Function

VBA - Bang Syntax Part1 - Worksheets, Dictionaries and User Classes

A flurry of ideas occurred today but I will start with the ! bang syntax. The bang (!) allows a more compact syntax of code to be written. It works by passing what follows to the default member. Some examples should clarify

Sub TestWorksheetsBang()
    
    Dim ws As Excel.Worksheet
    
    Set ws = ThisWorkbook.Worksheets!Sheet1
    'is equivalent to
    Set ws = ThisWorkbook.Worksheets.Item("Sheet1")

End Sub

Curiously, the Item method does not have DispId of 0 which is what I'd expect (it has &hAA instead). Nevertheless this works like a default member. Run the above code if you don't believe me.

Next example is using the Scripting.Dictionary from the Microsoft Scripting Runtime, the default methood is item which means we can write the following code. In this case Item does has Disp of 0.

Sub TestScriptingDictionaryBang()

    Dim oDic As Scripting.Dictionary      '* Tools->References Microsoft Scripting Runtime
    Set oDic = New Scripting.Dictionary
    
    oDic.Add "green", &H80
    oDic.Add "red", &H40
    oDic.Add "blue", &HFF
    
    Debug.Assert oDic.Count = 3
    Debug.Print oDic.Item("green")
    
    
    Debug.Print oDic("green")    '* I don't much like this
    Debug.Print oDic!green       '* for compactness I'd prefer this

End Sub

Final example in this part can we write our own classes and take advantage of bang syntax. Yes we can but we have to export the class module and annotate in a text editor the default member with Attribute Item.VB_UserMemID = 0 before re-importing. Here is a class which subclasses the Scripting.Dictionary and I have already annotated the Item method.

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "Dictionary2"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Private mdic As New Scripting.Dictionary   '* Tools->References Microsoft Scripting Runtime

Public Function Add(Key, Item)
    mdic.Add Key, Item
End Function

Public Function Exists(Key)
    Exists = mdic.Exists(Key)
End Function

Public Function Keys()
    Keys = mdic.Keys
End Function

Public Function Items()
    Items = mdic.Items
End Function

Public Property Get Item(Key)
    Attribute Item.VB_UserMemID = 0
    Item = mdic.Item(Key)
End Property

Public Property Get Count() As Long
    Count = mdic.Count
End Property

Public Sub Reset()
    Set mdic = New Scripting.Dictionary
End Sub

The client code for the above class is almost identical to before. Nevertheless here it is.

Sub TestVBADictionaryBang()

    Dim oDic2 As Dictionary2
    Set oDic2 = New Dictionary2
    
    oDic2.Add "green", &H80
    oDic2.Add "red", &H40
    oDic2.Add "blue", &HFF
    
    Debug.Assert oDic2.Count = 3
    Debug.Print oDic2.Item("green")
    
    
    Debug.Print oDic2("green")
    Debug.Print oDic2!green

End Sub