Excel VBA: Parsed JSON Object Loop

В соответствии с приведенным ниже примером... Циклирование объекта из разбора строки JSON возвращает ошибку "Объект не поддерживает это свойство или метод". Может ли кто-нибудь посоветовать, как сделать эту работу? Большое спасибо (я потратил 6 часов на поиск ответа, прежде чем спрашивать здесь).

Функция для разбора строки JSON в объект (это работает нормально).

Function jsonDecode(jsonString As Variant)
    Set sc = CreateObject("ScriptControl"): sc.Language = "JScript" 
    Set jsonDecode = sc.Eval("(" + jsonString + ")")
End Function

Цитирование через обработанный объект возвращает ошибку "Объект не поддерживает это свойство или метод".

Sub TestJsonParsing()
    Dim arr As Object 'Parse the json array into here
    Dim jsonString As String

    'This works fine
    jsonString = "{'key1':'value1','key2':'value2'}"
    Set arr = jsonDecode(jsonString)
    MsgBox arr.key1 'Works (as long as I know the key name)

    'But this loop doesn't work - what am I doing wrong?
    For Each keyName In arr.keys 'Excel errors out here "Object doesn't support this property or method"
        MsgBox "keyName=" & keyName
        MsgBox "keyValue=" & arr(keyName)
    Next
End Sub

PS. Я уже заглянул в эти библиотеки:

- vba-json Не удалось заставить этот пример работать.
- VBJSON Там нет vba script (это может работать, но не знает, как загрузить его в Excel, и существует минимальная документация).

Кроме того, возможно ли получить доступ к многомерным разборным массивам JSON? Просто получить одномерный цикл массива работать будет здорово (извините, если слишком много). Благодарю.

Изменить: Вот два рабочих примера с использованием библиотеки vba-json. Вопрос выше все еще остается загадкой, хотя...

Sub TestJsonDecode() 'This works, uses vba-json library
    Dim lib As New JSONLib 'Instantiate JSON class object
    Dim jsonParsedObj As Object 'Not needed

    jsonString = "{'key1':'val1','key2':'val2'}"
    Set jsonParsedObj = lib.parse(CStr(jsonString))

    For Each keyName In jsonParsedObj.keys
        MsgBox "Keyname=" & keyName & "//Value=" & jsonParsedObj(keyName)
    Next

    Set jsonParsedObj = Nothing
    Set lib = Nothing
End Sub

Sub TestJsonEncode() 'This works, uses vba-json library
    Dim lib As New JSONLib 'Instantiate JSON class object
    Set arr = CreateObject("Scripting.Dictionary")

    arr("key1") = "val1"
    arr("key2") = "val2"

    MsgBox lib.toString(arr)
End Sub

Ответы

Ответ 1

Объект JScriptTypeInfo является немного неудачным: он содержит всю необходимую информацию (как вы можете видеть в окне "Часы" ), но, похоже, это невозможно сделать с помощью VBA.

Если экземпляр JScriptTypeInfo ссылается на объект Javascript, For Each ... Next не будет работать. Однако он работает, если он ссылается на массив Javascript (см. Ниже GetKeys).

Итак, обходной путь - снова использовать механизм Javascript для получения информации, которую мы не можем с помощью VBA. Прежде всего, есть функция, чтобы получить ключи от объекта Javascript.

Как только вы знаете ключи, следующая проблема заключается в доступе к свойствам. VBA не поможет, если имя ключа известно только во время выполнения. Таким образом, существует два метода доступа к объекту объекта: один для значений, а другой для объектов и массивов.

Option Explicit

Private ScriptEngine As ScriptControl

Public Sub InitScriptEngine()
    Set ScriptEngine = New 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 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


Public Sub TestJsonAccess()
    Dim JsonString As String
    Dim JsonObject As Object
    Dim Keys() As String
    Dim Value As Variant
    Dim j As Variant

    InitScriptEngine

    JsonString = "{""key1"": ""val1"", ""key2"": { ""key3"": ""val3"" } }"
    Set JsonObject = DecodeJsonString(CStr(JsonString))
    Keys = GetKeys(JsonObject)

    Value = GetProperty(JsonObject, "key1")
    Set Value = GetObjectProperty(JsonObject, "key2")
End Sub

Примечание:

В коде используется раннее связывание. Поэтому вам нужно добавить ссылку на "Microsoft Script Control 1.0".
Вы должны вызвать InitScriptEngine один раз, прежде чем использовать другие функции, чтобы выполнить некоторую базовую инициализацию.

Ответ 2

Ответ Codo великолепен и составляет основу решения.

Тем не менее, знаете ли вы, что VBA CallByName поможет вам в поиске структуры JSON. Я только что написал решение в Google Places Details для Excel с VBA для примера.

На самом деле просто переписать его без использования функций добавления ScriptEngine в соответствии с этим примером. Я достиг зацикливания массива только с CallByName.

Итак, пример кода для иллюстрации

'Microsoft Script Control 1.0;  {0E59F1D2-1FBE-11D0-8FF2-00A0D10038BC}; C:\Windows\SysWOW64\msscript.ocx

Option Explicit

Sub TestJSONParsingWithVBACallByName()

    Dim oScriptEngine As ScriptControl
    Set oScriptEngine = New ScriptControl
    oScriptEngine.Language = "JScript"

    Dim jsonString As String
    jsonString = "{'key1':'value1','key2':'value2'}"

    Dim objJSON As Object
    Set objJSON = oScriptEngine.Eval("(" + jsonString + ")")

    Debug.Assert VBA.CallByName(objJSON, "key1", VbGet) = "value1"
    Debug.Assert VBA.CallByName(objJSON, "key2", VbGet) = "value2"

    Dim jsonStringArray As String
    jsonStringArray = "[ 1234, 4567]"

    Dim objJSONArray As Object
    Set objJSONArray = oScriptEngine.Eval("(" + jsonStringArray + ")")

    Debug.Assert VBA.CallByName(objJSONArray, "length", VbGet) = "2"

    Debug.Assert VBA.CallByName(objJSONArray, "0", VbGet) = "1234"
    Debug.Assert VBA.CallByName(objJSONArray, "1", VbGet) = "4567"


    Stop

End Sub

И это делает подобъекты (вложенные объекты), а также увидеть пример Google Maps в Google Places Подробности в Excel с VBA

РЕДАКТИРОВАТЬ: не используйте Eval, попробуйте разобрать JSON безопаснее, см. Этот пост в блоге

Ответ 3

Супер простой ответ - через силу OO (или это javascript;) Вы можете добавить метод item (n), который вы всегда хотели!

мой полный ответ здесь

Private ScriptEngine As ScriptControl

Public Sub InitScriptEngine()
    Set ScriptEngine = New ScriptControl
    ScriptEngine.Language = "JScript"
    ScriptEngine.AddCode "Object.prototype.myitem=function( i ) { return this[i] } ; "
    Set foo = ScriptEngine.Eval("(" + "[ 1234, 2345 ]" + ")") ' JSON array
    Debug.Print foo.myitem(1) ' method case sensitive!
    Set foo = ScriptEngine.Eval("(" + "{ ""key1"":23 , ""key2"":2345 }" + ")") ' JSON key value
    Debug.Print foo.myitem("key1") ' WTF

End Sub

Ответ 4

Поскольку Json - это ни что иное, как строки, поэтому его можно легко обрабатывать, если мы можем манипулировать им правильным способом, независимо от того, насколько сложна структура. Я не думаю, что нужно использовать любую внешнюю библиотеку или конвертер, чтобы сделать трюк. Вот пример, когда я обрабатывал json-данные, используя строковые манипуляции.

Sub Json_data()
Const URL = "https://api.redmart.com/v1.5.8/catalog/search?extent=2&pageSize=6&sort=1&category=bakery"
Dim http As New XMLHTTP60, html As New HTMLDocument
Dim str As Variant

With http
    .Open "GET", URL, False
    .send
    str = Split(.responseText, "category_tags"":")
End With
On Error Resume Next
y = UBound(str)

    For i = 1 To y
        Cells(i, 1) = Split(Split(str(i), "title"":""")(1), """")(0)
        Cells(i, 2) = Split(Split(str(i), "sku"":""")(1), """")(0)
        Cells(i, 3) = Split(Split(str(i), "price"":")(1), ",")(0)
        Cells(i, 4) = Split(Split(str(i), "desc"":""")(1), """")(0)
    Next i
End Sub

Ответ 5

Я знаю это поздно, но для тех, кто не знает, как использовать VBJSON, вам просто нужно:

1) Импортируйте JSON.bas в свой проект (Open VBA Editor, Alt + F11; File > Import File)

2) Добавить словарь/класс словаря Для Windows-only включите ссылку на "Время выполнения сценариев Microsoft"

Вы также можете использовать VBA-JSON таким же образом, который специфичен для VBA вместо VB6 и имеет всю документацию.

Ответ 6

Мне нужна помощь в получении заголовка X-RateLimit через VBA. Нет проблем получить контент JSON с помощью приведенного выше кода, но я должен проверить свойство "X-RateLimit-Remaining" и не знаю, как получить к нему доступ. Любая помощь для меня?