相关文章推荐
呐喊的李子  ·  赵家骧（中国国民革命军中将）_百度百科·  11 月前    · 
有爱心的海龟  ·  我靠外挂狩猎神明漫画免费 - ...·  1 年前    · 
帅气的酱牛肉  ·  耿乐：每一次道别都是为了下一次的重逢_同事_ ...·  1 年前    · 
豁达的单车  ·  5月中大型SUV销量排行榜：理想汽车包揽前2 ...·  1 年前    · 
纽基  ·  【揭秘】轮胎抓地能力关乎安全！大虎悠真人示范！·  3 年前    · 
Code  ›  使用VBA和VBA-JSON来访问Wordpress API的JSON数据
string post vba vba数组
https://www.qiniu.com/qfans/qnso-51125533
乖乖的李子
1 年前
七牛云社区 牛问答 使用VBA和VBA-JSON来访问Wordpress API的JSON数据

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

1 人关注

我正在建立一个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
    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"，但在网上研究了大约6个小时，并尝试了我能找到的许多变体，我仍然被困于如何访问其他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的范围，对这里的问题提出进一步的建议也会很有用。
19 个评论
omegastripes ：
请分享一个工作URL或张贴JSON样本。
chillin ：
也许我漏掉了什么，但在即时窗口中试试 ?JSON.items(1).items(1) )，或者如果你事先知道字典的键名 ?JSON("PutCollectionKeyNameHere")("PutDictionaryKeyNameHere")
chillin ：
另外，就在你的Exit Function上面，我认为 getJSON = JSON 应该是 Set getJSON = json ，因为你正在分配一个对象。
omegastripes ：
?json(1).count
jeromekjerome ：
下面是JSON响应文本
jeromekjerome ：
chillin, Set getJSON = json可以工作，但随后在调用函数时，在调用子中产生一个450错误 "参数数量错误或无效的属性分配"。
jeromekjerome ：
chillin，无论是?JSON.items(1).items(1)还是?Json.items(1).items(1)都不能在即时窗口中发挥作用。它们产生运行时错误424 "需要对象"
jeromekjerome ：
chillin ?Json("id")产生运行时错误5 "无效的过程调用或参数"
jeromekjerome ：
chllin, ?json.items(1).items(1) 产生错误 438 "对象不支持此属性或方法
SIM ：
如果你运行的是Windows 32位操作系统，有一个解决方案，它不依赖于任何外部转换器。如果版本相符，请告诉我。
omegastripes ：
@SIM 为什么 只有32位 ？
SIM ：
你是一笔宝贵的财富@omegastripes。我不知道还有一种方法可以玩转64位。谢谢。
jeromekjerome ：
我正在运行64位Windows 7。请不要建议改变来自Wordpress网站的JSON。 我不能控制它。由于这是一个单一案例的解决方案，解析JSON和构建POSt的JSON文本可以针对Wordpress的规范，不需要处理任何其他情况。
SIM ：
在发表任何评论之前，最好先了解一下相关的背景@TinMan。我不是 JsonConverter 的大粉丝。谢谢。
TinMan ：
@SIM 很公平。 我认为omegastripes的 JSON.Bas 很出色。 事实上，他的帖子并没有真正回答OP的问题。 所以，也许我错了，我不应该给他加注。
SIM ：
你又一次误解了我，亲爱的。我是欧米茄的忠实粉丝。无论他做什么，我都喜欢，因为它包含了一些新的东西可以学习。我不喜欢的是雇用任何外部转换器来做vba的事情。就这样吧。
jeromekjerome ：
@ omegastripes 现在我需要做一个往返的旅行。你是否有一个配套的片段，可以重构解压后的JSON，并将其重新打包起来？这应该是一个更简单的任务，因为现在的内容是已知的。
omegastripes ：
@Jerome 如果我没有理解错，你需要将JSON对象转换成JSON字符串？如果是这样，那么你可以直接使用 JSON.Serialize() 函数。
jeromekjerome ：
@ omegastripes 这个练习的总体目标是查询一个Wordpress网站（一般来说，但只有Wordpress，没有其他平台，所以数据的结构已经定义好了），将JSON解包到Excel（或Access），然后修改数据（Wordpress页面的内容），然后重新打包JSON并将其送回网站，从而更新页面。现在，你的代码已经解压并将其放入工作表，我只需要能够将相同的工作表，并将其中的数据重新打包成JSON，与你解压之前的方式相同。
json
wordpress
vba
api
wordpress-rest-api
jeromekjerome
jeromekjerome
发布于 2018-07-02
2 个回答
TinMan
TinMan
发布于 2020-01-03
0 人赞同

JsonConverter 返回一个VBA.Collections Scripting.Dictionaries和Values的集合。为了理解输出，你必须测试所有返回值的 TypeName 。

真正的问题是 "如何浏览一个 json 对象（或任何未知的对象）并访问其中的值。

使用 Immediate Window 和OP帖子中的 json 对象，我将尝试描述思维过程（以必读书籍的风格： 《小谋士 》）。 

' What is json?
?TypeName(JSON)
Collection
'json is a collection
'How big is JSON
?JSON.Count
'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)
'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")

当然，考虑到这个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
                Debug.Print Accessor
            End If
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
                        Debug.Print ArrayAccessor
                    End If
                Accessor = Prefix & "(" & Chr(34) & Key & Chr(34) & ")"
                Debug.Print Accessor
            End If
End If
End Sub

使用方法。


 PrintJSONAccessors JSON, "?JSON"

看来，MSScriptControl.ScriptControl只在32位系统上工作。我想这就是SIM在他的评论中所暗示的。虽然，我的答案在IMO上是正确的，但你应该忽略下一节的评论。


前言：我在Code Review上发布了一个将JSON解析为数组和字典的函数，使用VBA集合和数组返回类似JSON的对象。它不是JsonConverter或omegastripes的JSON.Bas的替代物。  它演示了你可以在CreateObject("MSScriptControl.ScriptControl")中添加JScript代码，并使用它来处理JSON。
QHarr ：
很好。MSScriptControl.ScriptControl是否适用于64位？ 我以为只适用于32位。使用ScriptControl有什么风险吗？
TinMan ：
@QHarr我并没有意识到这一点。 不管什么原因，Office 365拒绝安装我的系统的64位版本。 谢谢你的信息，兄弟!
QHarr ：
我想你在某个地方写过一个答案，你在jsonconverter.bas中给出了json对象的映射，即[] = collection etc.....。我想把你的答案提交给OP，但找不到了。你能记得那个答案吗？
TinMan ：
@QHarr 是这样的 如何获得，JSON值在VBA-JSON中工作？ [How to get, JSON values to Work in VBA-JSON?](https://stackoverflow.com/a/53494208/9912714)
QHarr ：
没有，但也很有用
omegastripes
omegastripes
发布于 2020-01-03
0 人赞同

试试这个代码。 

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

请看下面的例子。在VBA项目中导入JSON.bas模块，用于处理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 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
 
推荐文章
呐喊的李子  ·  赵家骧（中国国民革命军中将）_百度百科
11 月前
有爱心的海龟  ·  我靠外挂狩猎神明漫画免费 - 我靠外挂狩猎神明漫画 - 漫画在线全集免费阅读 - 腾讯动漫
1 年前
帅气的酱牛肉  ·  耿乐：每一次道别都是为了下一次的重逢_同事_公司_朋友
1 年前
豁达的单车  ·  5月中大型SUV销量排行榜：理想汽车包揽前2名，长城汽车拿到王炸|suv|电动车|出租车|一汽大众_网易订阅
1 年前
纽基  ·  【揭秘】轮胎抓地能力关乎安全！大虎悠真人示范！
3 年前
今天看啥   ·   Py中国   ·   codingpro   ·   藏经阁   ·   小百科   ·   link之家   ·   卧龙AI搜索
删除内容请联系邮箱 2879853325@qq.com
Code - 代码工具平台
© 2024 ~ 沪ICP备11025650号