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