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

Question

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

Я создаю приложение 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.

2

json vba wordpress api wordpress-rest-api

Источник

user797988 01 июл '18 в 17:35

2 ответа

Другие вопросы по тегам json vba wordpress api wordpress-rest-api

user9912714 02 июл '18 в 02:29 2018-07-02 02:29 · Answer 1 · 2018-07-02 02:29

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-карта в своих комментариях. Хотя мой ответ ИМО правильный, вы должны игнорировать следующий раздел комментариев.

К сведению: я опубликовал функцию, которая анализирует JSON в функции "Массивы и словари" для возврата объектов, похожих на JSON, с использованием коллекций и массивов VBA при проверке кода. Это не замена для JsonConverter или JSON.Bas от Omegastripes. Это демонстрирует, что вы можете добавить код JScript в CreateObject("MSScriptControl.ScriptControl") и использовать его для обработки JSON.

user2165759 01 июл '18 в 18:49 2018-07-01 18:49 · Answer 2 · 2018-07-01 18:49

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

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

ОБНОВИТЬ

Посмотрите на приведенный ниже пример. Импортируйте модуль 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.