VBA - Gut array from parsed JSON Document

So I recommend using ScriptControl with some added javascript libraries to parse a JSON document in VBA. I may have given the impression that parsed document is immutable, this is not the case. We can add some more javascript to the script control or we can rely on some intrinsic javascript function to modify the document. In this blog post I show how a JSON array can be gutted, i.e. elements deleted, using the instrinsic JavaScript function array.splice(). The code has a loop that removes 2 out of 3 elements of a simple array. (For loops we should count backwards from the end so as not to upset iterators and indices.)

Run the sub GutJSONArray() to see a Google Maps API markers array being modified.

One can always return the object to a string at the end of the process with oSC.Run("JSON_stringify", objParsed). See the final lines.

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"

        soSC.AddCode GetJavaScriptLibrary("https://raw.githubusercontent.com/douglascrockford/JSON-js/master/json2.js")
        soSC.AddCode "function JSON_stringify(jsonObj) { return JSON.stringify(jsonObj); } "
        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

Sub GutJSONArray()
    Dim oSC As ScriptControl
    Set oSC = SC

    Dim sGoogleMapsMarkers As String
    sGoogleMapsMarkers = "{ ""markers"": [  {  ""name"": ""Rixos The Palm Dubai"", ""position"": [25.1212, 55.1535]  }, " & _
            "{ ""name"": ""Shangri-La Hotel"", ""location"": [25.2084, 55.2719] }," & _
            "{ ""name"": ""Grand Hyatt"",  ""location"": [25.2285, 55.3273]     } ] }"

    Dim objParsed As Object
    Set objParsed = oSC.Run("JSON_parse", sGoogleMapsMarkers)
    
    Dim objMarkers As Object
    Set objMarkers = CallByName(objParsed, "markers", VbGet)
    
    Dim lLoop As Long
    For lLoop = 2 To 0 Step -2 '* count backwards when deleting
                
       Call CallByName(objMarkers, "splice", VbMethod, lLoop, 1) '* intrinsic javascript array.splice method
    
    Next lLoop
    
    Dim sGutted As String
    sGutted = oSC.Run("JSON_stringify", objParsed)

    Debug.Print sGutted
    Debug.Assert sGutted = "{""markers"":[{""name"":""Shangri-La Hotel"",""location"":[25.2084,55.2719]}]}"

End Sub