XML to JSON with VBA

In Delegating xml to json conversion to GAS I showed how you could get Google Apps Script to convert XML to JSON by posting the XML and getting back the JSON response – using VBA to illustrate. 


Here’s a native VBA version. Again we’ll be using cjobject (see  How to use cJobject) to hold the JSON representation of an XML object. In the example given here, we’ll do a query to an API and automatically detect if it is JSON or XML. If it’s XML, we’ll convert it to JSON. In either case – a cJobject is the result. 

The test

Like in Delegating xml to json conversion to GAS, first off we’ll use the open weather API. One thing i noticed is that this API the XML format returns a different dataset than the JSON format – strange but true.


Here’s all we need. I’m stringifying the returned object to JSON to be able to print the result.

Private Sub testGetAuto()
    Dim url As String
    url = _
     "http://api.openweathermap.org/data/2.5/weather?q=London&mode=xml"
    Debug.Print getAndMakeJobjectAuto(url).stringify(True)
End Sub

Although this returns XML (as shown in Delegating xml to json conversion to GAS), getAndMakeJobjectAuto() will convert it as required, giving this result. It’s not so good as the real JSON result, since all attributes are considered to be strings in XML, but perfectly usable, and actually better than the Google Apps Script version, since we don’t have those trailing Text elements observed in Delegating xml to json conversion to GAS

{
    "version": "1.0",
    "encoding": "utf-8",
    "current": {
        "city": {
            "id": "2643743",
            "name": "London",
            "coord": {
                "lon": "-0.12574",
                "lat": "51.50853"
            },
            "country": "GB",
            "sun": {
                "rise": "2013-10-30T06:51:47",
                "set": "2013-10-30T16:36:28"
            }
        },
        "temperature": {
            "value": "281.629",
            "min": "281.629",
            "max": "281.629",
            "unit": "kelvin"
        },
        "humidity": {
            "value": "86",
            "unit": "%"
        },
        "pressure": {
            "value": "1027.09",
            "unit": "hPa"
        },
        "wind": {
            "speed": {
                "value": "2.4",
                "name": "Light breeze"
            },
            "direction": {
                "value": "209.5",
                "code": "SSW",
                "name": "South-southwest"
            }
        },
        "clouds": {
            "value": "0",
            "name": "sky is clear"
        },
        "precipitation": {
            "mode": "no"
        },
        "weather": {
            "number": "800",
            "value": "Sky is Clear",
            "icon": "01d"
        },
        "lastupdate": {
            "value": "2013-10-30T10:02:45"
        }
    }
}

This time we’ll call the JSON version of the API

Private Sub testGetAuto()
    Dim url As String
    url = _
     "http://api.openweathermap.org/data/2.5/weather?q=London&mode=json"
    Debug.Print getAndMakeJobjectAuto(url).stringify(True)
End Sub

which gives us this

{
    "coord": {
        "lon": -0.12574,
        "lat": 51.50853
    },
    "sys": {
        "country": "GB",
        "sunrise": 1383115907,
        "sunset": 1383150988
    },
    "weather": [
        {
            "id": 800,
            "main": "Clear",
            "description": "Sky is Clear",
            "icon": "01d"
        }
    ],
    "base": "gdps stations",
    "main": {
        "temp": 281.629,
        "temp_min": 281.629,
        "temp_max": 281.629,
        "pressure": 1027.09,
        "sea_level": 1035.98,
        "grnd_level": 1027.09,
        "humidity": 86
    },
    "wind": {
        "speed": 2.4,
        "deg": 209.5
    },
    "rain": {
        "3h": 0
    },
    "clouds": {
        "all": 0
    },
    "dt": 1383128466,
    "id": 2643743,
    "name": "London",
    "cod": 200
}

Handling Arrays

In JSON an array is clearly identified [..]. In XML, not so much. Consider this

<names>
  <name>
    <first>john</first>
    <last>smith</last>
  </name>
  <name>
    <first>mary</first>
     <last>jones</last>
  </name>
</names>

It’s intuitively obvious that names is an array of name objects. The simple rule is that the converter will assume this is an array if child object element node names repeat. So the above example gets converted to 

{
    "names": [
        {
            "name": {
                "first": "john",
                "last": "smith"
            }
        },
        {
            "name": {
                "first": "mary",
                "last": "jones"
            }
        }
    ]
}

The code

Here’s the code for getting the data and converting it as necessary

Public Function getAndMakeJobjectFromXML(url As String) As cJobject
    ' we do an get on the given url
    Dim cb As cBrowser, helperUrl As String
    Set cb = New cBrowser
    helperUrl = _
     "https://script.google.com/macros/s/AKfycbziYOdWjNFtUR_TTQU-GiMYkan2h5ZDtaqeWIsYUAKEa6irjzNa/exec"

    With cb
        ' get the xml
        .httpGET url
        If .isOk Then
            Set getAndMakeJobjectFromXML = makeJobjectFromXML(.Text)
        Else
            MsgBox ("error getting " &amp; url)
        End If
        .tearDown
    End With
    
End Function

Here’s the parser.

Public Function xmlStringToJobject(xmlString As String, Optional complain As Boolean = True) As cJobject
    Dim doc As Object
    ' parse xml

    Set doc = createObject("msxml2.DOMDocument")
    doc.LoadXML xmlString
    If doc.parsed And doc.parseError = 0 Then
        Set xmlStringToJobject = docToJobject(doc, complain)
        Exit Function
    End If

    Set xmlStringToJobject = Nothing
    If complain Then
        MsgBox ("Invalid xml string - xmlparseerror code:" &amp; doc.parseError)
    End If
    
    Exit Function
    
End Function
rivate Function handleNode(node As IXMLDOMNode, job As cJobject, Optional arrayHead As Boolean = False) As cJobject
    Dim key As cJobject
    '' not a comprehensive convertor
    Set handleNode = job
    Debug.Print node.nodeName &amp; node.NodeType &amp; node.NodeValue
    Select Case node.NodeType
        Case NODE_ATTRIBUTE
            ' we cant have an array of attributes - this will silently use the latest
            job.add node.nodeName, node.NodeValue
            
        Case NODE_ELEMENT
            If job.isArrayRoot Then
                Dim b As Boolean
                b = (node.ChildNodes.length = 1)
                If (b) Then b = node.ChildNodes(0).NodeType = NODE_TEXT
                If (b) Then
                    Set handleNode = job.add.add
                Else
                    Set handleNode = job.add.add(node.nodeName)
                End If
            Else
                Set handleNode = job.add(node.nodeName)
            End If

        Case NODE_TEXT
            job.value = node.NodeValue

            
        Case NODE_DOCUMENT, NODE_CDATA_SECTION, NODE_ENTITY_REFERENCE, _
            NODE_ENTITY, NODE_PROCESSING_INSTRUCTION, NODE_COMMENT, NODE_DOCUMENT_TYPE, _
            NODE_DOCUMENT_FRAGMENT, NODE_NOTATION
            ' just ignore these for now

            
        Case Else
            Debug.Assert False
    End Select
    
End Function
Private Function handleNodes(parent As IXMLDOMNode, job As cJobject) As cJobject
    Dim node As IXMLDOMNode, joc As cJobject, attrib As IXMLDOMAttribute, i As Long, _
         arrayJob As cJobject
    
    If isArrayRoot(parent) Then
        ' we need an array associated with this this node
        ' subsequent members will need to make space for themselves
        Set joc = job.add(parent.nodeName).addArray
    Else
        Set joc = handleNode(parent, job)
    End If
    
    ' deal with any attributes
    If Not parent.Attributes Is Nothing Then
        For Each attrib In parent.Attributes
            handleNode attrib, joc
        Next attrib
    End If
    
    ' do the children
    If Not parent.ChildNodes Is Nothing And parent.ChildNodes.length > 0 Then
        For Each node In parent.ChildNodes
            handleNodes node, joc
        Next node
    End If
    
    ' always return the level at which we arrived
    Set handleNodes = job
    
End Function
Private Function isArrayRoot(parent As IXMLDOMNode) As Boolean
    
    Dim node As IXMLDOMNode, n As Long, node2 As IXMLDOMNode
    
    
    isArrayRoot = False
    If parent.NodeType = NODE_ELEMENT And parent.ChildNodes.length > 1 Then
        For Each node2 In parent.ChildNodes
            If node2.NodeType = NODE_ELEMENT Then
                n = 0
                For Each node In parent.ChildNodes
                    If node.NodeType = NODE_ELEMENT And _
                        node2.nodeName = node.nodeName Then n = n + 1
                Next node
                If n > 1 Then
                    ' this shoudl be true, but for leniency i'll comment
                    'Debug.Assert n = parent.ChildNodes.Length
                    isArrayRoot = True
                    Exit Function
                End If
            End If
        Next node2
    End If

    
End Function
Public Function docToJobject(doc As Object, Optional complain As Boolean = True) As cJobject
    ' convert xml document to a cjobject
    Dim node As IXMLDOMNode, job As cJobject
    Set job = New cJobject
    job.init Nothing
       
    Set docToJobject = handleNodes(doc, job)
End Function

Continue reading about Rest to Excel Library here.