Question

我要解析以下JSON字符串，并且需要提取“名称”和“ id”数组值，

{"results": [{"columns": [{"name": "name","stringArray": {"values": ["04-April", "05-May"]},"flagsArray": {"values": [15, 15]}}, {"name": "id","longlongArray": {"values": ["244", "245"]},"flagsArray": {"values": [15, 15]}}]}]}

我只是VBA的初学者，现在尝试使用在stackoverflow中找到的代码，

Parsing JSON in Excel VBA

我们非常感谢您的帮助来提取“名称”和“ id”数组值。

此外，链接中共享的代码不会解析json字符串，并且直到仅将keys（0）显示为“ results”为止，但是进一步，我无法继续获取“ columns”并进一步提取“ id”， “名称”

我的环境是Excel 64位（Office 365）

也欢迎您提出其他建议。

这是代码

Private ScriptEngine As ScriptControl
Sub InitScriptEngine()
    Set ScriptEngine = CreateObjectx86("MSScriptControl.ScriptControl")
    ScriptEngine.Language = "JScript"
    ScriptEngine.AddCode "function getProperty(jsonObj, propertyName) { return jsonObj[propertyName]; } "
    ScriptEngine.AddCode "function getKeys(jsonObj) { var keys = new Array(); for (var i in jsonObj) { keys.push(i); } return keys; } "
End Sub
Public Function HQL(query As String) As String
InitScriptEngine
Dim responseText As String
Dim JsonString As String
Dim JsonObject As Object
Dim Keys() As String
Dim Keys1() As String
Dim Value As Variant
Dim Value1 As Variant
Dim j As Variant
responseText = "{""results"": [{""columns"": [{""name"": ""name"",""stringArray"": {""values"": [""04-April"", ""05-May""]},""flagsArray"": {""values"": [15, 15]}}, {""name"": ""id"",""longlongArray"": {""values"": [""244"", ""245""]},""flagsArray"": {""values"": [15, 15]}}]}]}"
'responseText = "{""key1"": ""val1"", ""key2"": { ""key3"": ""val3"" } }"
Set JsonObject = DecodeJsonString(CStr(responseText))
Keys = GetKeys(JsonObject)
Value = GetProperty(JsonObject, "results")
Value1 = GetObjectProperty(JsonObject, "columns")
Keys1 = GetKeys(Value1)
MsgBox "Hello"
'End If
End Function
Function DecodeJsonString(ByVal JsonString As String)
    Set DecodeJsonString = ScriptEngine.Eval("(" + JsonString + ")")
End Function
Public Function GetProperty(ByVal JsonObject As Object, ByVal propertyName As String) As Variant
    GetProperty = ScriptEngine.Run("getProperty", JsonObject, propertyName)
End Function
Public Function GetObjectProperty(ByVal JsonObject As Object, ByVal propertyName As String) As Object
    Set GetObjectProperty = ScriptEngine.Run("getProperty", JsonObject, propertyName)
End Function
Public Function GetKeys(ByVal JsonObject As Object) As String()
    Dim Length As Integer
    Dim KeysArray() As String
    Dim KeysObject As Object
    Dim Index As Integer
    Dim Key As Variant

    Set KeysObject = ScriptEngine.Run("getKeys", JsonObject)
    Length = GetProperty(KeysObject, "length")
    ReDim KeysArray(Length - 1)
    Index = 0
    For Each Key In KeysObject
        KeysArray(Index) = Key
        Index = Index + 1
    Next
    GetKeys = KeysArray
End Function
Function CreateObjectx86(sProgID)

    Static oWnd As Object
    Dim bRunning As Boolean

    #If Win64 Then
        bRunning = InStr(TypeName(oWnd), "HTMLWindow") > 0
        If IsEmpty(sProgID) Then
            If bRunning Then oWnd.Close
            Exit Function
        End If
        If Not bRunning Then
            Set oWnd = CreateWindow()
            oWnd.execScript "Function CreateObjectx86(sProgID): Set CreateObjectx86 = CreateObject(sProgID): End Function", "VBScript"
        End If
        Set CreateObjectx86 = oWnd.CreateObjectx86(sProgID)
    #Else
        If Not IsEmpty(sProgID) Then Set CreateObjectx86 = CreateObject(sProgID)
    #End If

End Function
Function CreateWindow()

    Dim sSignature, oShellWnd, oProc

    On Error Resume Next
    sSignature = Left(CreateObject("Scriptlet.TypeLib").GUID, 38)
    CreateObject("WScript.Shell").Run "%systemroot%\syswow64\mshta.exe about:""<head><script>moveTo(-32000,-32000);document.title='x86Host'</script><hta:application showintaskbar=no /><object id='shell' classid='clsid:8856F961-340A-11D0-A96B-00C04FD705A2'><param name=RegisterAsBrowser value=1></object><script>shell.putproperty('" & sSignature & "',document.parentWindow);</script></head>""", 0, False
    Do
        For Each oShellWnd In CreateObject("Shell.Application").Windows
            Set CreateWindow = oShellWnd.GetProperty(sSignature)
            If Err.Number = 0 Then Exit Function
            Err.Clear
        Next
    Loop
End Function

Answer 1

我相信scriptControl是32位的。

在这里，我正在使用json parser从单元格A1中读取您的json。将JSONConverter.bas添加到项目后，您需要转到VBE>工具>引用>为Microsoft脚本运行时添加检查引用。

Public Sub GetInfo()
    Dim jsonStr As String
    jsonStr = [A1]
    Dim json As Object, item As Object
    Set json = JsonConverter.ParseJson(jsonStr)("results")(1)("columns")
    For Each item In json
        Debug.Print item("name")
    Next
End Sub

这是我在JSON对象中导航的路径：

{}指示通过键访问的字典。 []表示按索引访问的集合。

您还可以使用Split

Public Sub GetInfo2()
    Dim jsonStr As String, arr() As String, i As Long
    jsonStr = [A1]
    arr = Split(jsonStr, "name"":")
    If UBound(arr) > 0 Then
    For i = 1 To UBound(arr)
        Debug.Print Split(arr(i), ",")(0)
    Next
    End If
End Sub

如果您实际上位于“值”集合对象之后，则：

Public Sub GetInfo()
    Dim jsonStr As String3
    jsonStr = [A1]
    Dim json As Object, item As Object, key As Variant
    Set json = JsonConverter.ParseJson(jsonStr)("results")(1)("columns")
    For Each item In json
        For Each key In item
           Select Case key
           Case "stringArray", "longlongArray"
               Debug.Print item(key)("values")(1), item(key)("values")(2)
           End Select
        Next
    Next
End Sub

如果需要所有values集合值：

Public Sub GetInfo4()
    Dim jsonStr As String
    jsonStr = [A1]
    Dim json As Object, item As Object, key As Variant, key2 As Variant, i As Long
    Set json = JsonConverter.ParseJson(jsonStr)("results")(1)("columns")
    For Each item In json
        For Each key In item
            Select Case TypeName(item(key))
              Case "String"
              Case "Dictionary"
              For Each key2 In item(key)
                  For i = 1 To item(key)(key2).Count
                      Debug.Print item(key)(key2)(i)
                  Next
              Next
            End Select
        Next key
    Next
End Sub

无法使用在stackoverflow中找到的VBA代码解析json字符串

1 个答案: