我正在尝试使用 VB6 中的 Web 服务。我控制的服务目前可以返回 SOAP/XML 消息或 JSON。我很难弄清楚 VB6 的 SOAP 类型（版本 1）是否可以处理返回的object - 而不是像string、int 等简单类型。到目前为止，我无法弄清楚我需要什么要做的就是让 VB6 使用返回的对象。
所以我想我可以将 Web 服务中的响应序列化为 JSON 字符串。 VB6 是否存在 JSON 解析器？
【问题讨论】：
标签： web-services json vba serialization vb6
查看JSON.org 以获取许多不同语言的 JSON 解析器的最新列表（参见主页底部）。在撰写本文时，您将在那里看到几个不同 JSON 解析器的链接，但只有一个用于 VB6/VBA（其他的是 .NET）：
这个 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")
【讨论】：
基于 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
【讨论】：
希望这对其他在搜索“vba json”后继续访问此页面的人有很大帮助。
我发现这个page 很有帮助。它提供了几个与 Excel 兼容的 VBA 类，用于处理 JSON 格式的数据。
【讨论】：
更新：找到了一种比使用 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 loop through a JSON array parsed?
Q5In Excel VBA on Windows, for parsed JSON variables what is this JScriptTypeInfo anyway?
【讨论】：
这是一个“本机”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
如果你觉得有用，请投票
【讨论】：
cstr(oJson)，它确实给出了[object JSON]
由于 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
【讨论】：
VB6 - JsonBag, Another JSON Parser/Generator 也应该可以轻松导入 VBA。
【讨论】：
我建议使用 .Net 组件。您可以通过Interop 使用来自VB6 的.Net 组件——这里是tutorial。我的猜测是 .Net 组件将比为 VB6 生成的任何东西更可靠和更好的支持。
Microsoft .Net 框架中有一些组件，例如 DataContractJsonSerializer 或 JavaScriptSerializer。您还可以使用第三方库，例如 JSON.NET。
【讨论】：
您可以在 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
【讨论】：
了解这是一篇旧帖子，但我最近在向旧的 VB6 应用程序添加 Web 服务消费时偶然发现了它。接受的答案（VB-JSON）仍然有效并且似乎可以工作。但是，我发现 Chilkat 已更新为包含 REST 和 JSON 功能，使其成为我的一站式（虽然付费）工具。他们甚至有一个在线代码生成器，可以生成代码来解析粘贴的 JSON 数据。
【讨论】：
使用解析 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 数据。
【讨论】：
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
工具 -> 参考资料 -> 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
【讨论】：
这是 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
【讨论】：