Excel VBA: Parsed JSON Object Loop

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

Функция для parsingа строки 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 Solutions collect form web for “Excel VBA: Parsed JSON Object Loop”

Объект 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 вызвать InitScriptEngine прежде чем использовать другие функции, чтобы выполнить некоторую базовую инициализацию.

Супер простой ответ – через силу 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 

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

Тем не менее, знаете ли вы, что CallByName от VBA позволяет вам довольно подробно разбираться в структуре 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 Details в Excel с 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 в свой проект (Open VBA Editor, Alt + F11; File> Import File)

2) Добавить словарный словарь / class Для Windows-only включить ссылку на «Microsoft Scripting Runtime»

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

  • Способ запуска макросов Excel из командной строки или командного файла?
  • Удаление строки в Excel VBA
  • Код для циклического преобразования всех записей в MS Access
  • Как оптимизировать функцию VBA в Excel
  • Загрузите файл csv в массив VBA, а не в Excel Sheet
  • Возвращает диапазон от A1 до истинной последней используемой ячейки
  • Умный способ подключения нескольких изображений к макросу макроса - VAB Excel
  • Быстрый метод сравнения из 2 столбцов
  • скрытие формул в строке формул
  • Создание массива из диапазона в VBA
  • Загрузка добавлений при программном программировании Excel
  • Давайте будем гением компьютера.