Использование VBA и VBA-JSON для доступа к данным JSON из Wordpress API

Question

Я создаю приложение VBA, которое создает и изменяет страницы веб-сайта Wordpress, используя ресурсы, извлеченные из Интернета. Wordpress API возвращает файл JSON, но встроенная поддержка синтаксического анализа JSON в VBA отсутствует, поэтому я импортировал VBA-JSON из GitHub. Вот подпрограмма:

Sub Wordpress()

    '
    ' Wordpress API Test
    '
    Dim wpResp As Variant
    Dim sourceSheet As String
    Dim resourceURL As String
    sourceSheet = "Resources"
    resourceURL = Sheets(sourceSheet).Cells(6, 1)
    wpResp = getJSON(resourceURL + "/wp-json/wp/v2/posts")

End Sub

И вызываемая им функция.

Function getJSON(link) As Object

    Dim response As String
    Dim json As Object
    On Error GoTo recovery
    Dim retryCount As Integer
    retryCount = 0
    Dim web As MSXML2.XMLHTTP60
    Set web = New MSXML2.XMLHTTP60

the_start:

    web.Open "GET", link, False, UserName, pw
    web.setRequestHeader "Content-type", "application/json"
    web.send
    response = web.responseText
    While web.readyState <> 4
        DoEvents
    Wend

    On Error GoTo 0

    Debug.Print link
    Debug.Print web.Status; "XMLHTTP status "; web.statusText; " at "; Time

    Set json = JsonConverter.ParseJson(response)

    'getJSON = json ' this line produces Object variable or With block variable not set error but I can deal with it later

    Exit Function

recovery:

    retryCount = retryCount + 1
    Debug.Print "Error number: " & Err.Number & " " & Err.Description & " Retry " & retryCount
    Application.StatusBar = "Error number: " & Err.Number & " " & Err.Description & " Retry " & retryCount
    If retryCount < 4 Then GoTo the_start Else Exit Function
End Function

Этот код возвращает объект / коллекцию с 1 элементом, который содержит вариант / объект / словарь с 24 элементами, но я теряюсь, как получить доступ к этим элементам. Вот скриншот:

Если я использую непосредственное окно для запроса? Json.count, я получаю правильный результат «1», но после примерно шести часов исследования в Интернете и пробуя столько вариантов, сколько смог найти, я все еще застрял на том, как чтобы получить доступ к другим 24.

Вот JSON:

[{"id":1,"date":"2018-06-22T18:13:00","date_gmt":"2018-06-22T22:13:00","guid":{"rendered":"http:\/\/mytestsite.org\/?p=1"},"modified":"2018-06-22T18:13:00","modified_gmt":"2018-06-22T22:13:00","slug":"hello-world","status":"publish","type":"post","link":"http:\/\/mytestsite.org\/hello-world\/","title":{"rendered":"Blog Post Title"},"content":{"rendered":"<p>What goes into a blog post? Helpful, industry-specific content that: 1) gives readers a useful takeaway, and 2) shows you&#8217;re an industry expert. <\/p>\n<p>Use your company&#8217;s blog posts to opine on current industry topics, humanize your company, and show how your products and services can help people.<\/p>\n","protected":false},"excerpt":{"rendered":"<p>What goes into a blog post? Helpful, industry-specific content that: 1) gives readers a useful takeaway, and 2) shows you&#8217;re&hellip;<\/p>\n","protected":false},"author":1,"featured_media":212,"comment_status":"open","ping_status":"open","sticky":false,"template":"","format":"standard","meta":[],"categories":[1],"tags":[],"_links":{"self":[{"href":"http:\/\/mytestsite.org\/wp-json\/wp\/v2\/posts\/1"}],"collection":[{"href":"http:\/\/mytestsite.org\/wp-json\/wp\/v2\/posts"}],"about":[{"href":"http:\/\/mytestsite.org\/wp-json\/wp\/v2\/types\/post"}],"author":[{"embeddable":true,"href":"http:\/\/mytestsite.org\/wp-json\/wp\/v2\/users\/1"}],"replies":[{"embeddable":true,"href":"http:\/\/mytestsite.org\/wp-json\/wp\/v2\/comments?post=1"}],"version-history":[{"href":"http:\/\/mytestsite.org\/wp-json\/wp\/v2\/posts\/1\/revisions"}],"wp:featuredmedia":[{"embeddable":true,"href":"http:\/\/mytestsite.org\/wp-json\/wp\/v2\/media\/212"}],"wp:attachment":[{"href":"http:\/\/mytestsite.org\/wp-json\/wp\/v2\/media?parent=1"}],"wp:term":[{"taxonomy":"category","embeddable":true,"href":"http:\/\/mytestsite.org\/wp-json\/wp\/v2\/categories?post=1"},{"taxonomy":"post_tag","embeddable":true,"href":"http:\/\/mytestsite.org\/wp-json\/wp\/v2\/tags?post=1"}],"curies":[{"name":"wp","href":"https:\/\/api.w.org\/{rel}","templated":true}]}}]

В конце дня я хочу иметь возможность раскрутить несколько сотен страниц WP-контента, извлеченного и сопоставленного из нескольких интернет-источников, и поддерживать их в актуальном состоянии с помощью этого приложения. Дополнительные предложения, выходящие за рамки этой проблемы, также будут полезны, если мы не выйдем за пределы VBA.

Answer 1

JsonConverter возвращает коллекцию VBA.Collections Scripting.Dictionaries и Values. Чтобы понять вывод, вам нужно проверить TypeName всех возвращаемых значений.

Реальный вопрос - «Как перемещаться по объекту json (или любому неизвестному объекту в этом отношении) и получать доступ к значениям внутри.

Немедленное окно

Используя объект Immediate Window и json из поста ОП, я попытаюсь описать мыслительный процесс (в стиле обязательной книги: Маленький интриган )

' What is json?
?TypeName(JSON)
Collection

'json is a collection
'How big is JSON
?JSON.Count
 1 

'JSON is a collection of 1 Item
'What is Type that Item?
?TypeName(JSON(1))
Dictionary

'JSON(1) is a Dictionary
'What is the first key in the JSON(1) Dictionary?
?JSON(1).Keys()(0)
id

'The first key in the JSON(1) Dictionary is "id"
'What is the Type of the value of "id"?
?TypeName(JSON(1)("id"))
Double

'JSON(1)("id") is a number
'What is its value
?JSON(1)("id")
 1 

Конечно, этот процесс может стать утомительным, учитывая количество вложений в этот объект JSON.

JSON (1) ( "_ ссылки") ( "кюри") (1) ( "шаблонный")

Коллекция | Словарь | Словарь | Коллекция | Логическое значение

Итак, я думаю, что лучше всего написать функцию, которая распечатает все средства доступа к Immediate Window и пойдет оттуда.

PrintJSONAccessors: Sub

Sub PrintJSONAccessors(JSON As Variant, Optional Prefix As String)
    Dim data As Variant, Key As Variant, Value As Variant
    Dim Accessor As String, ArrayAccessor As String
    Dim n As Long
    If TypeName(JSON) = "Collection" Then
        For n = 1 To JSON.Count
            Accessor = Prefix & "(" & n & ")"
            If TypeName(JSON(n)) = "Dictionary" Or TypeName(JSON(n)) = "Collection" Then
                PrintJSONAccessors JSON(n), Accessor
            Else
                Debug.Print Accessor
            End If
        Next
    Else
        For Each Key In JSON
            If TypeName(Key) = "Dictionary" Or TypeName(Key) = "Collection" Then
                PrintJSONAccessors Key, Prefix
            ElseIf TypeName(JSON(Key)) = "Dictionary" Or TypeName(JSON(Key)) = "Collection" Then
                Accessor = Prefix & "(" & Chr(34) & Key & Chr(34) & ")"
                PrintJSONAccessors JSON(Key), Accessor
            ElseIf TypeName(JSON(Key)) = "Dictionary" Then
                Accessor = Prefix & "(" & Chr(34) & Key & Chr(34) & ")"
                PrintJSONAccessors JSON(Key), Accessor
            ElseIf TypeName(JSON(Key)) = "Variant()" Then
                data = JSON(Key)
                For n = LBound(data) To UBound(data)
                    Accessor = Prefix & "(" & Chr(34) & Key & Chr(34) & ")"
                    ArrayAccessor = Prefix & "(" & Chr(34) & Key & Chr(34) & ")" & "(" & n & ")"
                    If TypeName(data(n)) = "Dictionary" Then
                        PrintJSONAccessors data(n), ArrayAccessor
                    Else
                        Debug.Print ArrayAccessor
                    End If
                Next
            Else
                Accessor = Prefix & "(" & Chr(34) & Key & Chr(34) & ")"
                Debug.Print Accessor
            End If
        Next
    End If
End Sub

Использование:

 PrintJSONAccessors JSON, "?JSON"

---

Похоже, что MSScriptControl.ScriptControl работает только на 32-битных системах. Я думаю, это то, на что ссылалась SIM-карта в своих комментариях Хотя мой ответ ИМО правильный, вам следует игнорировать следующий раздел комментариев.

Answer 2

Попробуйте код:

    Set json = JsonConverter.ParseJson(s)
    For Each k In json(1)
        Debug.Print k & vbTab & json(1)(k)
    Next

UPDATE

Посмотрите на приведенный ниже пример. Импорт JSON.bas модуля в проект VBA для обработки JSON.

Option Explicit

Sub Test()

    Dim sJSONString As String
    Dim vJSON
    Dim sState As String
    Dim aData()
    Dim aHeader()
    Dim vResult

    ' Read JSON sample from file C:\Test\sample.json
    sJSONString = ReadTextFile("C:\Test\sample.json", 0)
    ' Parse JSON sample
    JSON.Parse sJSONString, vJSON, sState
    If sState = "Error" Then
        MsgBox "Invalid JSON"
        End
    End If
    ' Get the 1st element from root [] array
    Set vJSON = vJSON(0)
    ' Convert raw JSON to 2d array and output to worksheet #1
    JSON.ToArray vJSON, aData, aHeader
    With Sheets(1)
        .Cells.Delete
        .Cells.WrapText = False
        OutputArray .Cells(1, 1), aHeader
        Output2DArray .Cells(2, 1), aData
        .Columns.AutoFit
    End With
    ' Flatten JSON
    JSON.Flatten vJSON, vResult
    ' Convert flattened JSON to 2d array and output to worksheet #2
    JSON.ToArray vResult, aData, aHeader
    With Sheets(2)
        .Cells.Delete
        .Cells.WrapText = False
        OutputArray .Cells(1, 1), aHeader
        Output2DArray .Cells(2, 1), aData
        .Columns.AutoFit
    End With
    MsgBox "Completed"

End Sub

Sub OutputArray(oDstRng As Range, aCells As Variant)

    With oDstRng
        .Parent.Select
        With .Resize(1, UBound(aCells) - LBound(aCells) + 1)
            .NumberFormat = "@"
            .Value = aCells
        End With
    End With

End Sub

Sub Output2DArray(oDstRng As Range, aCells As Variant)

    With oDstRng
        .Parent.Select
        With .Resize( _
                UBound(aCells, 1) - LBound(aCells, 1) + 1, _
                UBound(aCells, 2) - LBound(aCells, 2) + 1)
            .NumberFormat = "@"
            .Value = aCells
        End With
    End With

End Sub

Function ReadTextFile(sPath As String, lFormat As Long) As String

    ' lFormat -2 - System default, -1 - Unicode, 0 - ASCII
    With CreateObject("Scripting.FileSystemObject").OpenTextFile(sPath, 1, False, lFormat)
        ReadTextFile = ""
        If Not .AtEndOfStream Then ReadTextFile = .ReadAll
        .Close
    End With

End Function

Кстати, аналогичный подход применяется в следующих ответах: 1 , 2 , 3 , 4 , 5 , 6 , 7 , 8 , 9 , 10 , 11 , 12 , 13 , 14 , 15 , 16 , 17 и 18 .