我正在尝试在VB6中使用Web服务。我控制的服务 - 当前可以返回SOAP / XML消息或JSON。我很难弄清楚VB6的SOAP类型（版本1）是否可以处理返回的object - 而不是像string，int等简单类型。到目前为止我无法弄清楚我需要做些什么来让VB6与返回的对象一起玩。
所以我想我可能会将Web服务中的响应序列化为JSON字符串。是否存在VB6的JSON解析器？
答案 0 :(得分：39)
查看JSON.org以获取许多不同语言的JSON解析器的最新列表（请参阅主页底部）。截至撰写本文时，您将看到两个不同JSON解析器的链接：
这个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")
答案 1 :(得分：14)
以ozmike解决方案为基础，这对我不起作用（Excel 2013和IE10）。 原因是我无法在公开的JSON对象上调用方法。 因此，它的方法现在通过附加到DOMElement的函数公开。 不知道这是可能的（必须是那个IDispatch-thing），谢谢你ozmike。
正如ozmike所说，没有第三方库，只有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
答案 2 :(得分：7)
我知道这是一个古老的问题，但我的回答对希望在搜索“vba json”之后继续访问此页面的其他人有很大的帮助。
我发现这个page非常有帮助。它提供了几个与Excel兼容的VBA类，用于处理JSON格式的数据处理。
答案 3 :(得分：5)
更新：找到一种比使用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
我实际上已经完成了一系列Q＆amp; As探索JSON / VBA相关主题。
Q2 In Excel VBA on Windows, how to loop through a JSON array parsed?
Q5 In Excel VBA on Windows, for parsed JSON variables what is this JScriptTypeInfo anyway?
答案 4 :(得分：4)
这是一个“Native”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
如果找到有用的
，请进行投票答案 5 :(得分：4)
答案 6 :(得分：3)
VB6 - JsonBag, Another JSON Parser/Generator也应该可以轻松导入VBA。
答案 7 :(得分：2)
我建议使用.Net组件。您可以通过Interop使用VB6中的.Net组件 - 这是tutorial。我的猜测是.Net组件比VB6生成的任何组件都更可靠，支持更好。
Microsoft .Net框架中有一些组件，如DataContractJsonSerializer或JavaScriptSerializer。您还可以使用JSON.NET等第三方库。
答案 8 :(得分：2)
您可以在VB.NET中编写Excel-DNA加载项。 Excel-DNA是一个瘦库，可让您在.NET中编写XLL。通过这种方式，您可以访问整个.NET Universe，并可以使用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
答案 9 :(得分：2)
由于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
答案 10 :(得分：1)
了解这是一篇旧文章，但是最近我在将Web服务使用情况添加到旧的VB6应用程序时偶然发现了它。接受的答案（VB-JSON）仍然有效，并且似乎可以使用。但是，我发现Chilkat已更新为包括REST和JSON功能，从而使其成为我的一站式（尽管付费）工具。他们甚至还有一个在线代码生成器，该生成器生成用于解析粘贴的JSON数据的代码。
答案 11 :(得分：0)
使用解析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数据。
答案 12 :(得分：0)
EXCEL CELL中的公式
=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
工具 - ＆gt;参考文献 - ＆gt; 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
答案 13 :(得分：0)
这是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()
MsgBox JsonGet("key1", "{'key1': 'value1' ,'key2': { 'key3': 'value3' } }")''returns "value1"
MsgBox JsonGet("key2.key3", "{'key1': 'value1' ,'key2': { 'key3': 'value3' } }") ''returns "value3"
MsgBox JsonGet("result.0.Ask", "{'result':[{'MarketName':'BTC-1ST','Bid':0.00004718,'Ask':0.00004799},{'MarketName':'BTC-2GIVE','Bid':0.00000073,'Ask':0.00000074}]}") ''returns "0.00004799"
MsgBox JsonGet("mykey2.keyinternal1", "{mykey:1111, mykey2:{keyinternal1:22.1,keyinternal2:22.2}, mykey3:3333}") ''returns "22.1"
End Sub
Public Function JsonGet(eKey$, eJsonString$, Optional eDlim$ = ".") As String
Dim tmp$()
Static sJsonString$
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
End Function
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Set objJSON = Nothing
End Sub