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 " & 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:" & doc.parseError) End If Exit Function End Function
Private 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 & node.NodeType & 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.