VBA递归解析JSON

tokido

Option Explicit
Public Function Get_JSON()
    Dim ht As Object
    Dim arrkeys() As Integer
    Set ht = CreateObject("MSXML2.XMLHTTP")
    Dim url As String
    url = "https://api.apiopen.top/getImages"
    ht.Open "GET", url, False
    ht.send
    Do While ht.readyState <> 4
        DoEvents
    Loop
    Get_JSON = ht.responsetext
End Function
Public Sub JSON_Analysis1()
    '初步设想通过递归遍历完成解析
    Dim strJSON As String
    strJSON = Get_JSON()
    Call Recursion_JScriptTypeInfo(strJSON)
End Sub
Sub Recursion_JScriptTypeInfo(strJSON As String)
    Dim objJSON As Object
    Dim arrkeys() As String
    Dim j As Integer, k
    Dim strJSCode As String
    Dim objkeys As Object
    Dim intKeyLen As Integer
    strJSCode = "function JSGetValue(jsonObj,strKey){return jsonObj[strKey];}"
    strJSCode = strJSCode & " function JSGetKeys(jsonObj){var keys=new Array();for(var key in jsonObj){keys.push(key);}return keys;} "
    With CreateObject("MSScriptControl.ScriptControl")
        .Language = "javascript"
        .AddCode strJSCode
        Set objJSON = .eval("(" + strJSON + ")")
        Set objkeys = .Run("JSGetKeys", objJSON)    '(code, message, result)
        intKeyLen = .Run("JSGetValue", objkeys, "length")
        ReDim arrkeys(intKeyLen - 1)
        j = 0
        For Each k In objkeys
            arrkeys(j) = k
            j = j + 1
        Next
        For Each k In arrkeys
            Debug.Print Trim(k)
            If TypeName(.Run("JSGetValue", objJSON, k)) <> "JScriptTypeInfo" Then
                Debug.Print Trim(.Run("JSGetValue", objJSON, k))
            Else
                strJSON = .Run("JSGetValue", objJSON, k)
                Call Recursion_JScriptTypeInfo(strJSON)
            End If
        Next
    End With
End Sub

tokido

各位大佬，我是一名初学者，想实现递归解析JSON，但是运行会报错“缺少‘]’”，不知道问题出在哪，希望各位能给点帮助。

vbexcelhome

可以借鉴别人的代码 ，看看下面的帖子
JSON解析原理及代码
http://www.json.org/json-zh.html
代码：http://www.ediy.co.nz/vbjson-jso ... -vb6-xidc55680.html

《纯vba代码解析json格式数据》
http://club.excelhome.net/thread-1448414-1-1.html

《网页数据采集---网页文档解析篇(json/html/xml) 》
http://club.excelhome.net/thread-1303169-1-1.html

《【网页采集教程】【高级篇】第二课-使用VBA解析JSON格式的网页 》
http://club.excelhome.net/thread-939881-1-1.html

。。。。。。。

实在太多了，举例都举不过来了。
对了，还有我的JSON类，也是纯代码解析，不过我发布的是最初的试验版，除了不带数组解析，可以实现生成与解析。同一帖子中还有一个利用这个类写的JSON数据查看工具。

tokido

vbexcelhome 发表于 2019-5-30 12:32
可以借鉴别人的代码 ，看看下面的帖子
JSON解析原理及代码
http://www.json.org/json-zh.html

嗯  好的  谢谢  我先看看

tokido

上面的问题没解决,但是让我找到另一种方法实现递归...也算曲线救国？
Sub 字典解析JSON()
    Dim jsonStr As String
    jsonStr = Get_JSON()
    Dim jsonObject As New JSON
    Set dict = jsonObject.parse(jsonStr)
    Call Recursion_Collection(dict)
End Sub
Public Function Get_JSON()
    Dim ht As Object
    Dim arrkeys() As Integer
    Set ht = CreateObject("MSXML2.XMLHTTP")
    Dim url As String
    url = "https://api.apiopen.top/getImages"
    ht.Open "GET", url, False
    ht.send
    Do While ht.readyState <> 4
        DoEvents
    Loop
    Get_JSON = ht.ResponseText
End Function
Sub Recursion_Collection(dict)
    For Each s_key In dict.keys()
        If TypeName(dict(s_key)) <> "Collection" Then
            Debug.Print s_key & ":" & dict(s_key)
        Else
            Set res_coll = dict(s_key)
            Dim i As Integer
            For i = 1 To res_coll.Count()
                Set dict = res_coll(i)
                Call Recursion_Collection(dict)
            Next
        End If
    Next
End Sub

tokido

上面的问题没解决，但是让我换了一种方法实现了。。。
Sub 字典解析JSON()
    Dim jsonStr As String
    jsonStr = Get_JSON()
    Dim jsonObject As New JSON
    Set dict = jsonObject.parse(jsonStr)
    Call Recursion_Collection(dict)
End Sub
Public Function Get_JSON()
    Dim ht As Object
    Dim arrkeys() As Integer
    Set ht = CreateObject("MSXML2.XMLHTTP")
    Dim url As String
    url = "https://api.apiopen.top/getImages"
    ht.Open "GET", url, False
    ht.send
    Do While ht.readyState <> 4
        DoEvents
    Loop
    Get_JSON = ht.ResponseText
End Function
Sub Recursion_Collection(dict)
    For Each s_key In dict.keys()
        If TypeName(dict(s_key)) <> "Collection" Then
            Debug.Print s_key & ":" & dict(s_key)
        Else
            Set res_coll = dict(s_key)
            Dim i As Integer
            For i = 1 To res_coll.Count()
                Set dict = res_coll(i)
                Call Recursion_Collection(dict)
            Next
        End If
    Next
End Sub

vbexcelhome

tokido 发表于 2019-5-30 15:48
上面的问题没解决，但是让我换了一种方法实现了。。。
Sub 字典解析JSON()
    Dim jsonStr As String

如果碰到JSON数据，可以先粘贴到软件中看看。下面这个数据是论坛一个网友需要的摹课数据，挺好的数据，正是数组里面再嵌套数组的例子。
自己写的解析类完全没有问题。我又根据这个数据增加了一个函数，调用数据更简单、方便。自己写代码解析优点就是方便。

jsonView2.rar (47.73 KB, 下载次数: 8)

2019-5-30 23:17 上传

点击文件名下载附件

解析摹课JSON数据所用的代码（最下面的那个）

liucqa

一般来说，vba解析json的最省事办法是调用htmlfile

Kaohsing

原汤化原食。JavaScript也不错。

tokido

统一回复  感谢各位的意见和帮助！