Excel VBA: анализируемый цикл объектов JSON

Для примера ниже... Цикл по объекту из проанализированной строки 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 включены (это может работать, но не знаю, как загрузить его в 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
Источник

5 ответов

Решение

JScriptTypeInfo Объект немного неудачен: он содержит всю необходимую информацию (как вы можете видеть в окне Watch), но, кажется, невозможно достичь этого с помощью 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 один раз, прежде чем использовать другие функции, чтобы сделать некоторую базовую инициализацию.
Источник

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

Тем не менее, знаете ли вы, что 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

Источник

Супер простой ответ - с помощью ОО (или это 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
Источник

Итак, это 2020 год, и все же из-за отсутствия сквозного решения я наткнулся на эту тему. Это действительно помогло, но если нам нужно получить доступ к данным без ключей во время выполнения динамически, ответы, приведенные выше, по-прежнему нуждаются в еще нескольких настройках, чтобы получить желаемые данные.

Наконец-то я придумал функцию, позволяющую получить комплексное решение этой проблемы синтаксического анализа JSON в VBA. Что делает эта функция, так это то, что она принимает строку JSON (вложенную на любой уровень) в качестве входных данных и возвращает отформатированный двумерный массив. Этот массив в дальнейшем можно было бы легко переместить на рабочий лист с помощью простых циклов i/j или можно было бы удобно воспроизводить из-за его легкой доступности на основе индекса.

Пример ввода-вывода

Функция сохраняется в файле JSON2Array.bas в моем репозитории Github. JSON2Array-VB

Подпрограмма демонстрационного использования также включена в файл.bas. Загрузите и импортируйте файл в свои модули VBA. Я надеюсь, что это помогает.

Источник

Поскольку 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
Источник

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

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

2) Добавить ссылку на словарь / класс. Только для Windows, включить ссылку на "Microsoft Scripting Runtime".

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

Источник
Другие вопросы по тегам