Парсинг JSON в MSAccess

[docfell]

Понадобилось тут из MS Access отправлять и получать данные с веб-сервера в формате JSON.
Простые запросы GET разрулились просто:

Function HttpGet(AUrl As String, AAuth As String) As String
Dim Http As Object
HttpGet = ""
Set Http = CreateObject("MSXML2.XMLHTTP")
Http.Open "GET", AUrl, False
If AAuth <> "" Then
Http.SetRequestHeader "Authorization", AAuth
End If
Http.Send
HttpGet = Http.ResponseText
Set Http = Nothing
End Function

Однако в процессе выяснилось, что некоторые запросы возвращают портянки JSON примерно такого вида:

{"Organizations":[
{"Id":1123,
"Name":"Org1",
"Persons":[
{"Id":11,
"FirstName":"Вася",
"LastName":"Пупкин",
"Email":"vasya@org1.com"},
{"Id":112529,
"LastName":"Техотдел",
"PersonsInRole":[221071,83472,373515,455898]}]
},
{"Id":25499,
"Name":"Org2",
"Persons":[
{"Id":181671,
"FirstName":"Иван",
"LastName":"Петров",
"Email":"ivan@org2.com"},
{"Id":400086,"FirstName":"Петр",
"LastName":"Сидоров",
"Email":"petr@org2.com"}]]

То есть в виде JSON передается массив Organizations, а в каждом его элементе есть массив Persons со списком персонала.

Появилась задача как-то это распарсивать.



Полдня ковыряния на форумах и выяснилось, что наиболее быстрым и наглядным способом распарсить такие портянки будет использование движка ScriptControl из недр винды.
В этом движке можно быстро и изящно средствами JavaScript обратиться к объектам JSON и получить их значения в MS Access.

Public Type Contact
Id As Long
firstName As String
lastName As String
Org As String
End Type

Dim Contacts() As Contact
Dim X, I, J, OrgCnt, PersCnt As Integer
Dim PersId As Long
Dim strResponse, strOrganization, firstName, lastName As String
Dim Sc, Org, Pers As Object

' получили json с сервера
strResponse = HttpGet("https://site.com/restapi/orgs", strAccessToken)

' инициализация скриптового движка
Set Sc = CreateObject("ScriptControl")
Sc.Language = "JScript"
' подготовка к парсингу JSON
' очистка текста от лишних символов
strResponse = Replace(strResponse, vbCrLf, "")
strResponse = Replace(strResponse, vbTab, "")
' парсинг JSON
Sc.Eval "var obj=(" & strResponse & ")"

' подготовка функций JScript для получения данных из JSON
Sc.AddCode "function getOrganizationCount() {return obj.Organizations.length;}"
Sc.AddCode "function getOrganization(i) {return obj.Organizations[i];}"
Sc.AddCode "function getPersonsCount(Organization) {return Organization.Persons.length;}"
Sc.AddCode "function getPerson(Organization, i) {return Organization.Persons[i];}"
Sc.AddCode "function getFirstName(Person) {return Person.FirstName;}"
Sc.AddCode "function getLastName(Person) {return Person.LastName;}"

' получение кол-ва организаций в JSON ответе
OrgCnt = Sc.Run("getOrganizationCount")

X = 0
' проход по организациям
For I = 0 To OrgCnt - 1
' получаем объект-организацию
Set Org = Sc.Run("getOrganization", I)
' получаем ее название
strOrganization = Org.Name
' кол-во контактов в организации
PersCnt = Sc.Run("getPersonsCount", Org)
' проход по всем контактам одной организации
For J = 0 To PersCnt - 1
' получем объект - контакт
Set Pers = Sc.Run("getPerson", Org, J)
' увеличиваем размер массива результатов
ReDim Preserve Contacts(X)
' получаем данные по контакту
PersId = Pers.Id
firstName = Sc.Run("getFirstName", Pers)
lastName = Sc.Run("getLastName", Pers)
' записываем данные в массив
Contacts(X).Id = PersId
Contacts(X).firstName = firstName
Contacts(X).lastName = lastName
Contacts(X).Org = strOrganization
' увеличиваем счетчик
X = X + 1
Next J
Next I

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