是否有适用于 VB6/VBA 的 JSON 解析器？
Posted
技术标签:
【中文标题】是否有适用于 VB6/VBA 的 JSON 解析器？【英文标题】：Is There a JSON Parser for VB6 / VBA? 【发布时间】：2022-01-21 23:58:49 【问题描述】：我正在尝试使用 VB6 中的 Web 服务。我控制的服务目前可以返回 SOAP/XML 消息或 JSON。我很难弄清楚 VB6 的 SOAP 类型（版本 1）是否可以处理返回的object - 而不是像string、int 等简单类型。到目前为止，我无法弄清楚我需要什么要做的就是让 VB6 使用返回的对象。
所以我想我可以将 Web 服务中的响应序列化为 JSON 字符串。 VB6 是否存在 JSON 解析器？
【问题讨论】：
我在下面有一个答案，但我现在找到了更好的方法exceldevelopmentplatform.blogspot.com/2018/01/… 【参考方案1】：查看JSON.org 以获取许多不同语言的 JSON 解析器的最新列表（参见主页底部）。在撰写本文时，您将在那里看到几个不同 JSON 解析器的链接，但只有一个用于 VB6/VBA（其他的是 .NET）：
VB-JSON
当我尝试下载 zip 文件时，Windows 说数据已损坏。但是，我可以使用7-zip 来提取文件。事实证明，zip 文件中的主“文件夹”不被 Windows 识别为文件夹，通过 7-zip 可以看到该主“文件夹”的内容，因此您可以打开它然后相应地提取文件.这个 VB JSON 库的实际语法非常简单：
Dim p As Object
Set p = JSON.parse(strFormattedJSON)
'Print the text of a nested property '
Debug.Print p.Item("AddressClassification").Item("Description")
'Print the text of a property within an array '
Debug.Print p.Item("Candidates")(4).Item("ZipCode")
【讨论】：
有没有办法用 VB-JSON 传递一个 Class 对象并返回相应的 JSON 字符串？谢谢！ 如何循环槽对象？说 p.Item("AddressClassification") 包含 3 个项目。如何循环遍历这些项目？ @AlexandreH.Tremblay 您应该能够像遍历 VB6/VBA 中的任何数组一样遍历项目 @BenMcCormack 你能看看这个***.com/questions/26229563/… 吗？【参考方案2】：我建议使用 .Net 组件。您可以通过Interop 使用来自VB6 的.Net 组件——这里是tutorial。我的猜测是 .Net 组件将比为 VB6 生成的任何东西更可靠和更好的支持。
Microsoft .Net 框架中有一些组件，例如 DataContractJsonSerializer 或 javascriptSerializer。您还可以使用第三方库，例如 JSON.NET。
【讨论】：
感谢您的建议。您提出了一个很好的观点，即 .NET 组件将比 VB6 中的任何东西得到更好的支持。确实如此。但是（我在这里可能错了），JSON 很简单，即使是 VB6 也不应该有问题。到目前为止，我提到的 VB-JSON 代码运行良好。 @Ben JSON 很简单，但是你说作为起点的 google 代码项目仍然设法有几个错误，所以仍然有可能出错。【参考方案3】：希望这对其他在搜索“vba json”后继续访问此页面的人有很大帮助。
我发现这个page 很有帮助。它提供了几个与 Excel 兼容的 VBA 类，用于处理 JSON 格式的数据。
【讨论】：
你会推荐哪一个？【参考方案4】：VB6 - JsonBag, Another JSON Parser/Generator 也应该可以轻松导入 VBA。
【讨论】：
【参考方案5】：这是一个“本机”VB JSON 库。
可以使用 IE8+ 中已有的 JSON。这样您就不会依赖于过时且未经测试的第三方库。
查看 amedeus 的替代版本here
Sub myJSONtest()
Dim oJson As Object
Set oJson = oIE_JSON() ' See below gets IE.JSON object
' using json objects
Debug.Print oJson.parse(" ""hello"": ""world"" ").hello ' world
Debug.Print oJson.stringify(oJson.parse(" ""hello"": ""world"" ")) ' "hello":"world"
' getting items
Debug.Print oJson.parse(" ""key1"": ""value1"" ").key1 ' value1
Debug.Print oJson.parse(" ""key1"": ""value1"" ").itemGet("key1") ' value1
Debug.Print oJson.parse("[ 1234, 4567]").itemGet(1) ' 4567
' change properties
Dim o As Object
Set o = oJson.parse(" ""key1"": ""value1"" ")
o.propSetStr "key1", "value\""2"
Debug.Print o.itemGet("key1") ' value\"2
Debug.Print oJson.stringify(o) ' "key1":"value\\\"2"
o.propSetNum "key1", 123
Debug.Print o.itemGet("key1") ' 123
Debug.Print oJson.stringify(o) ' "key1":123
' add properties
o.propSetNum "newkey", 123 ' addkey! JS MAGIC
Debug.Print o.itemGet("newkey") ' 123
Debug.Print oJson.stringify(o) ' "key1":123,"newkey":123
' assign JSON 'objects' to properties
Dim o2 As Object
Set o2 = oJson.parse(" ""object2"": ""object2value"" ")
o.propSetJSON "newkey", oJson.stringify(o2) ' set object
Debug.Print oJson.stringify(o) ' "key1":123,"newkey":"object2":"object2value"
Debug.Print o.itemGet("newkey").itemGet("object2") ' object2value
' change array items
Set o = oJson.parse("[ 1234, 4567]") '
Debug.Print oJson.stringify(o) ' [1234,4567]
Debug.Print o.itemGet(1)
o.itemSetStr 1, "234"
Debug.Print o.itemGet(1)
Debug.Print oJson.stringify(o) ' [1234,"234"]
o.itemSetNum 1, 234
Debug.Print o.itemGet(1)
Debug.Print oJson.stringify(o) ' [1234,234]
' add array items
o.itemSetNum 5, 234 ' add items! JS Magic
Debug.Print o.itemGet(5) ' 234
Debug.Print oJson.stringify(o) ' [1234,234,null,null,null,234]
' assign JSON object to array item
o.itemSetJSON 3, oJson.stringify(o2) ' assign object
Debug.Print o.itemGet(3) '[object Object]
Debug.Print oJson.stringify(o.itemGet(3)) ' "object2":"object2value"
Debug.Print oJson.stringify(o) ' [1234,234,null,"object2":"object2value",null,234]
oIE_JSON_Quit ' quit IE, must shut down or the IE sessions remain.
Debug.Print oJson.stringify(o) ' can use after but but IE server will shutdown... soon
End Sub
您可以从 VB 桥接到 IE.JSON。 创建一个函数oIE_JSON
Public g_IE As Object ' global
Public Function oIE_JSON() As Object
' for array access o.itemGet(0) o.itemGet("key1")
JSON_COM_extentions = "" & _
" Object.prototype.itemGet =function( i ) return this[i] ; " & _
" Object.prototype.propSetStr =function( prop , val ) eval('this.' + prop + ' = ""' + protectDoubleQuotes (val) + '""' ) ; " & _
" Object.prototype.propSetNum =function( prop , val ) eval('this.' + prop + ' = ' + val + '') ; " & _
" Object.prototype.propSetJSON =function( prop , val ) eval('this.' + prop + ' = ' + val + '') ; " & _
" Object.prototype.itemSetStr =function( prop , val ) eval('this[' + prop + '] = ""' + protectDoubleQuotes (val) + '""' ) ; " & _
" Object.prototype.itemSetNum =function( prop , val ) eval('this[' + prop + '] = ' + val ) ; " & _
" Object.prototype.itemSetJSON =function( prop , val ) eval('this[' + prop + '] = ' + val ) ; " & _
" function protectDoubleQuotes (str) return str.replace(/\\/g, '\\\\').replace(/""/g,'\\""'); "
' document.parentwindow.eval dosen't work some versions of ie eg ie10?
IEEvalworkaroundjs = "" & _
" function IEEvalWorkAroundInit () " & _
" var x=document.getElementById(""myIEEvalWorkAround"");" & _
" x.IEEval= function( s ) return eval(s) ; ;"
g_JS_framework = "" & _
JSON_COM_extentions & _
IEEvalworkaroundjs
' need IE8 and DOC type
g_JS_html = "<!DOCTYPE html> " & _
" <script>" & g_JS_framework & _
"</script>" & _
" <body>" & _
"<script id=""myIEEvalWorkAround"" onclick=""IEEvalWorkAroundInit()"" ></script> " & _
" HEllo</body>"
On Error GoTo error_handler
' Create InternetExplorer Object
Set g_IE = CreateObject("InternetExplorer.Application")
With g_IE
.navigate "about:blank"
Do While .Busy: DoEvents: Loop
Do While .ReadyState <> 4: DoEvents: Loop
.Visible = False ' control IE interface window
.Document.Write g_JS_HTML
End With
Set objID = g_IE.Document.getElementById("myIEEvalWorkAround")
objID.Click ' create eval
Dim oJson As Object
'Set oJson = g_IE.Document.parentWindow.Eval("JSON") ' dosen't work some versions of IE
Set oJson = objID.IEEval("JSON")
Set objID = Nothing
Set oIE_JSON = oJson
Exit Function
error_handler:
MsgBox ("Unexpected Error, I'm quitting. " & Err.Description & ". " & Err.Number)
g_IE.Quit
Set g_IE = Nothing
End Function
Public Function oIE_JSON_Quit()
g_IE.Quit
Exit Function
End Function
如果你觉得有用，请投票
【讨论】：
不适用于 Excel 2013 和 IE10：无法对返回的 JSON 对象调用方法。我所能做的就是cstr(oJson)，它确实给出了[object JSON]
thx 我没有 2013 年要测试，但一旦我这样做了，我会调查它。如果您能找到解决办法，请告诉我们。【参考方案6】：
基于 ozmike 解决方案，这对我不起作用（Excel 2013 和 IE10）。 原因是我无法调用暴露的 JSON 对象的方法。 因此，它的方法现在通过附加到 DOMElement 的函数公开。 不知道这是可能的（一定是 IDispatch 的东西），谢谢 ozmike。
正如 ozmike 所说，没有第 3 方库，只有 30 行代码。
Option Explicit
Public JSON As Object
Private ie As Object
Public Sub initJson()
Dim html As String
html = "<!DOCTYPE html><head><script>" & _
"Object.prototype.getItem=function( key ) return this[key] ; " & _
"Object.prototype.setItem=function( key, value ) this[key]=value ; " & _
"Object.prototype.getKeys=function( dummy ) keys=[]; for (var key in this) if (typeof(this[key]) !== 'function') keys.push(key); return keys; ; " & _
"window.onload = function() " & _
"document.body.parse = function(json) return JSON.parse(json); ; " & _
"document.body.stringify = function(obj, space) return JSON.stringify(obj, null, space); " & _
"" & _
"</script></head><html><body id='JSONElem'></body></html>"
Set ie = CreateObject("InternetExplorer.Application")
With ie
.navigate "about:blank"
Do While .Busy: DoEvents: Loop
Do While .readyState <> 4: DoEvents: Loop
.Visible = False
.document.Write html
.document.Close
End With
' This is the body element, we call it JSON:)
Set JSON = ie.document.getElementById("JSONElem")
End Sub
Public Function closeJSON()
ie.Quit
End Function
以下测试从头开始构造一个 JavaScript 对象，然后将其字符串化。 然后它解析对象并遍历它的键。
Sub testJson()
Call initJson
Dim jsObj As Object
Dim jsArray As Object
Debug.Print "Construction JS object ..."
Set jsObj = JSON.Parse("")
Call jsObj.setItem("a", 1)
Set jsArray = JSON.Parse("[]")
Call jsArray.setItem(0, 13)
Call jsArray.setItem(1, Math.Sqr(2))
Call jsArray.setItem(2, 15)
Call jsObj.setItem("b", jsArray)
Debug.Print "Object: " & JSON.stringify(jsObj, 4)
Debug.Print "Parsing JS object ..."
Set jsObj = JSON.Parse("""a"":1,""b"":[13,1.4142135623730951,15]")
Debug.Print "a: " & jsObj.getItem("a")
Set jsArray = jsObj.getItem("b")
Debug.Print "Length of b: " & jsArray.getItem("length")
Debug.Print "Second element of b: "; jsArray.getItem(1)
Debug.Print "Iterate over all keys ..."
Dim keys As Object
Set keys = jsObj.getKeys("all")
Dim i As Integer
For i = 0 To keys.getItem("length") - 1
Debug.Print keys.getItem(i) & ": " & jsObj.getItem(keys.getItem(i))
Next i
Call closeJSON
End Sub
输出
Construction JS object ...
Object:
"a": 1,
"b": [
13,
1.4142135623730951,
15
]
Parsing JS object ...
a: 1
Length of b: 3
Second element of b: 1,4142135623731
Iterate over all keys ...
a: 1
b: 13,1.4142135623730951,15
【讨论】：
【参考方案7】：您可以在 VB.NET 中编写 Excel-DNA 插件。 Excel-DNA 是一个精简库，可让您在 .NET 中编写 XLL。通过这种方式，您可以访问整个 .NET 世界，并且可以使用 http://james.newtonking.com/json 之类的东西 - 一个在任何自定义类中反序列化 JSON 的 JSON 框架。
如果您有兴趣，这里有一篇关于如何使用 VB.NET 为 Excel 构建通用 Excel JSON 客户端的文章：
http://optionexplicitvba.com/2014/05/09/developing-a-json-excel-add-in-with-vb-net/
这是代码的链接：https://github.com/spreadgit/excel-json-client/blob/master/excel-json-client.dna
【讨论】：
【参考方案8】：使用解析 JSON 的 JavaScript 功能，在 ScriptControl 之上，我们可以在 VBA 中创建一个解析器，它将列出 JSON 中的每个数据点。无论数据结构多么嵌套或复杂，只要我们提供一个有效的 JSON，这个解析器就会返回一个完整的树形结构。
JavaScript 的 Eval、getKeys 和 getProperty 方法为验证和读取 JSON 提供了构建块。
结合 VBA 中的递归函数，我们可以遍历 JSON 字符串中的所有键（最多 n 级）。然后使用 Tree 控件（在本文中使用）或字典甚至在简单的工作表上，我们可以根据需要排列 JSON 数据。
完整的 VBA 代码在这里。使用解析 JSON 的 JavaScript 功能，在 ScriptControl 之上，我们可以在 VBA 中创建一个解析器，它将列出 JSON 中的每个数据点。无论数据结构多么嵌套或复杂，只要我们提供一个有效的 JSON，这个解析器就会返回一个完整的树形结构。
JavaScript 的 Eval、getKeys 和 getProperty 方法为验证和读取 JSON 提供了构建块。
结合 VBA 中的递归函数，我们可以遍历 JSON 字符串中的所有键（最多 n 级）。然后使用 Tree 控件（在本文中使用）或字典甚至在简单的工作表上，我们可以根据需要排列 JSON 数据。
Full VBA Code here.
【讨论】：
【参考方案9】：VBA-JSON 由 Tim Hall，MIT 许可 和 GitHub 提供。这是 2014 年底出现的 vba-json 的另一个分支。声称可以在 Mac Office 以及 32 位和 64 位 Windows 上运行。
【讨论】：
包含在VBA-Web 中，非常适合网络请求。也适用于 Mac。【参考方案10】：更新：找到了一种比使用 Eval 更安全的 JSON 解析方式，这篇博文展示了 Eval 的危险...http://exceldevelopmentplatform.blogspot.com/2018/01/vba-parse-json-safer-with-jsonparse-and.html
迟到了，但很抱歉，到目前为止，最简单的方法是使用 Microsoft Script Control。一些使用 VBA.CallByName 进行钻取的示例代码
'Tools->References->
'Microsoft Script Control 1.0; 0E59F1D2-1FBE-11D0-8FF2-00A0D10038BC; C:\Windows\SysWOW64\msscript.ocx
Private Sub TestJSONParsingWithCallByName()
Dim oScriptEngine As ScriptControl
Set oScriptEngine = New ScriptControl
oScriptEngine.Language = "JScript"
Dim sJsonString As String
sJsonString = "'key1': 'value1' ,'key2': 'key3': 'value3' "
Dim objJSON As Object
Set objJSON = oScriptEngine.Eval("(" + sJsonString + ")")
Debug.Assert VBA.CallByName(objJSON, "key1", VbGet) = "value1"
Debug.Assert VBA.CallByName(VBA.CallByName(objJSON, "key2", VbGet), "key3", VbGet) = "value3"
End Sub
我实际上已经完成了一系列问答，探索 JSON/VBA 相关主题。
第一季度In Excel VBA on Windows, how to mitigate issue of dot syntax traversal of parsed JSON broken by IDE's capitalisation behaviour?
第二季度In Excel VBA on Windows, how to loop through a JSON array parsed?
第三季度In Excel VBA on Windows, how to get stringified JSON respresentation instead of “[object Object]” for parsed JSON variables?
第四季度In Windows Excel VBA,how to get JSON keys to pre-empt “Run-time error '438': Object doesn't support this property or method”?
Q5In Excel VBA on Windows, for parsed JSON variables what is this JScriptTypeInfo anyway?
【讨论】：
这应该是答案。 JSON 键区分大小写（oScriptEngine.Eval 返回的 VBA 对象中的键不区分） 这似乎不适用于 64 位，因为微软没有将它移植到 64 位！【参考方案11】：EXCEL 单元格中的公式
=JSON2("mykey:1111, mykey2:keyinternal1:22.1,keyinternal2:22.2, mykey3:3333", "mykey2", "keyinternal2")
显示：22.2
=JSON("mykey:1111,mykey2:2222,mykey3:3333", "mykey2")
显示：2222
说明： 步骤 1。按 ALT+F11 步骤 2。插入 -> 模块 步骤 3。工具 -> 参考 -> 勾选 Microsoft Script Control 1.0 第四步。将其粘贴到下方。 步骤 5。 ALT+Q 关闭 VBA 窗口。工具 -> 参考资料 -> Microsoft Script Control 1.0； 0E59F1D2-1FBE-11D0-8FF2-00A0D10038BC； C:\Windows\SysWOW64\msscript.ocx
Public Function JSON(sJsonString As String, Key As String) As String
On Error GoTo err_handler
Dim oScriptEngine As ScriptControl
Set oScriptEngine = New ScriptControl
oScriptEngine.Language = "JScript"
Dim objJSON As Object
Set objJSON = oScriptEngine.Eval("(" + sJsonString + ")")
JSON = VBA.CallByName(objJSON, Key, VbGet)
Err_Exit:
Exit Function
err_handler:
JSON = "Error: " & Err.Description
Resume Err_Exit
End Function
Public Function JSON2(sJsonString As String, Key1 As String, Key2 As String) As String
On Error GoTo err_handler
Dim oScriptEngine As ScriptControl
Set oScriptEngine = New ScriptControl
oScriptEngine.Language = "JScript"
Dim objJSON As Object
Set objJSON = oScriptEngine.Eval("(" + sJsonString + ")")
JSON2 = VBA.CallByName(VBA.CallByName(objJSON, Key1, VbGet), Key2, VbGet)
Err_Exit:
Exit Function
err_handler:
JSON2 = "Error: " & Err.Description
Resume Err_Exit
End Function
【讨论】：
【参考方案12】：由于 Json 只是字符串，因此如果我们能够以正确的方式操作它，无论结构多么复杂，它都可以轻松处理。我认为没有必要使用任何外部库或转换器来做到这一点。这是我使用字符串操作解析 json 数据的示例。
Sub GetJsonContent()
Dim http As New XMLHTTP60, itm As Variant
With http
.Open "GET", "http://jsonplaceholder.typicode.com/users", False
.send
itm = Split(.responseText, "id"":")
End With
x = UBound(itm)
For y = 1 To x
Cells(y, 1) = Split(Split(itm(y), "name"": """)(1), """")(0)
Cells(y, 2) = Split(Split(itm(y), "username"": """)(1), """")(0)
Cells(y, 3) = Split(Split(itm(y), "email"": """)(1), """")(0)
Cells(y, 4) = Split(Split(itm(y), "street"": """)(1), """")(0)
Next y
End Sub
【讨论】：
这适用于简单的 JSON 对象。对于具有嵌套集合和嵌套对象的对象来说，它不够通用。【参考方案13】：这是 vb6 示例代码，测试正常，工作完成
从上面的好例子中，我做了一些改变，得到了很好的结果
它可以读取键 和数组 []
Option Explicit
'in vb6 click "Tools"->"References" then
'check the box "Microsoft Script Control 1.0";
Dim oScriptEngine As New ScriptControl
Dim objJSON As Object
''to use it
Private Sub Command1_Click()
Dim json$
json="'key1': 'value1' ,'key2': 'key3': 'value3' "
MsgBox JsonGet("key1", json) 'result = value1
json="'key1': 'value1' ,'key2': 'key3': 'value3' "
MsgBox JsonGet("key2.key3",json ) 'result = value3
json="'result':['Bid':0.00004718,'Ask':0.00004799]"
MsgBox JsonGet("result.0.Ask", json) 'result = 0.00004799
json="key1:1111, key2:k1: 2222 , k2: 3333, key3:4444"
MsgBox JsonGet("key2.k1", json) 'result = 2222
json="'usd_rur':'bids':[[1111,2222],[3333,4444]]"
MsgBox JsonGet("usd_rur.bids.0.0", json) 'result = 1111
MsgBox JsonGet("usd_rur.bids.0.1", json) 'result = 2222
MsgBox JsonGet("usd_rur.bids.1.0", json) 'result = 3333
MsgBox JsonGet("usd_rur.bids.1.1", json) 'result = 4444
End Sub
Public Function JsonGet(eKey$, eJsonString$, Optional eDlim$ = ".") As String
Dim tmp$()
Static sJsonString$
On Error GoTo err
If Trim(eKey$) = "" Or Trim(eJsonString$) = "" Then Exit Function
If sJsonString <> eJsonString Then
sJsonString = eJsonString
oScriptEngine.Language = "JScript"
Set objJSON = oScriptEngine.Eval("(" + eJsonString + ")")
End If
tmp = Split(eKey, eDlim)
If UBound(tmp) = 0 Then JsonGet = VBA.CallByName(objJSON, eKey, VbGet): Exit Function
Dim i&, o As Object
Set o = objJSON
For i = 0 To UBound(tmp) - 1
Set o = VBA.CallByName(o, tmp(i), VbGet)
Next i
JsonGet = VBA.CallByName(o, tmp(i), VbGet)
Set o = Nothing
err: 'if key not found, result = "" empty string
End Function
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Set objJSON = Nothing
Set oScriptEngine = Nothing
End Sub
【讨论】：
【参考方案14】：了解这是一篇旧帖子，但我最近在向旧的 VB6 应用程序添加 Web 服务消费时偶然发现了它。接受的答案（VB-JSON）仍然有效并且似乎可以工作。但是，我发现 Chilkat 已经更新为包含 REST 和 JSON 功能，使其成为我的一站式（虽然是付费的）工具。他们甚至有一个在线代码生成器，可以生成代码来解析粘贴的 JSON 数据。
JsonObject link
Code Generator link
【讨论】：
以上是关于是否有适用于 VB6/VBA 的 JSON 解析器？的主要内容，如果未能解决你的问题，请参考以下文章
RestKit 中的 elementToPropertyMapping
适用于 Android 项目的 Bamboo Junit 测试解析器
是否有适用于cordova phonegap 的视频剪辑器插件？