
Function JsonParse(jsonString) As Object
    Dim htmlfile As Object
    Set htmlfile = CreateObject("htmlfile")
    htmlfile.write "<!doctype html><html><head><meta http-equiv='X-UA-Compatible' content='IE=edge' /><script>Object.prototype.getKeys=function() { if( Object.prototype.toString.call(this) === '[object Array]') return ; var keys = [];  for (var i in this) {  if (this.hasOwnProperty(i)) { keys.push(i); }  } return keys; } ;Object.prototype.getItem = function(k) { return this[k] } ;</script>"

    Dim oWindow As Object
    Set oWindow = htmlfile.parentWindow

    Dim json2 As Object
    Set json2 = oWindow.eval("JSON")

    Dim jsonObject As Object
    On Error Resume Next
    Set jsonObject = CallByName(json2, "parse", VbMethod, jsonString)
    On Error GoTo 0
    
    If jsonObject Is Nothing Then
        oWindow.execScript "var $$$jsonObject=" & jsonString
        Set jsonObject = oWindow.eval("$$$jsonObject")
    End If

    On Error Resume Next
    Dim keys As Object
    Set keys = CallByName(jsonObject, "getKeys", VbMethod)
    On Error GoTo 0

    Dim dict  As Object
    If Not keys Is Nothing Then
        Set dict = CreateObject("Scripting.Dictionary")
        
        Dim length As Long
        length = CallByName(keys, "length", VbGet)
        
        Dim idx As String
        Dim val As Variant
        Dim x As Long
        For x = 0 To length - 1
            idx = CallByName(keys, x, VbGet)
            val = CallByName(jsonObject, "getItem", VbMethod, idx)
            dict.Add idx, val
        Next x
        
        Set JsonParse = dict
        Exit Function
    End If
    
    On Error Resume Next
    length = CallByName(jsonObject, "length", VbGet)
    On Error GoTo 0

    Dim jsonArray  As Object
    If Err.Number = 0 Then
        Set jsonArray = New Collection
      
        Dim i As Long
        For i = 0 To length - 1
            jsonArray.Add CallByName(jsonObject, i, VbGet)
        Next i
        
        Set JsonParse = jsonArray
        Exit Function
    End If

    Err.Raise 10001, "JsonParse", "Unknown error parsing JSON"
    Set JsonParse = Null
End Function
