Question

我正在构建一个VBA应用程序，该应用程序使用从网络抓取的资源来创建和修改Wordpress网站页面。 Wordpress API返回一个JSON文件，但是在VBA中不支持解析JSON，因此我从GitHub导入了VBA-JSON。这是子例程：

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对象（或与此相关的任何未知对象）并访问其中的值。

立即窗口

使用OP帖子中的Immediate Window和json对象，我将尝试描述思维过程（以必读书籍的风格：The Little Schemer）

' 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）（“ _ links”）（“ curies”）（1）（“ templated”）

集合|字典|字典|集合|布尔值

所以我想最好的办法是编写一个函数，该函数将所有访问器打印到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在他的评论中提到的。尽管我的回答是IMO正确的，但您应该忽略下一部分评论。

仅供参考：：我发布了一个函数，该函数将JSON解析为Function to Return a JSON Like Objects Using VBA Collections and Arrays上的数组和字典Code Review。它不能代替JsonConverter或omegastripes的JSON.Bas。它说明您可以将JScript代码添加到CreateObject("MSScriptControl.ScriptControl")并使用它来处理JSON。

Answer 2

尝试输入代码：

    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，{{ 3}}，15，16和17。

使用VBA和VBA-JSON从Wordpress API访问JSON数据

2 个答案:

立即窗口

PrintJSONAccessors：Sub

用法：