是否有一个JSONparsing器VB6 / VBA？
我正在尝试在VB6中使用Web服务。 我所控制的服务当前可以返回SOAP / XML消息或JSON。 我有一个非常困难的时间搞清楚，如果VB6的SOAPtypes（版本1）可以处理返回的object – 而不是简单的types，如string ， int等等。到目前为止，我不知道我需要做什么来获得VB6玩返回的对象。
所以我想我可能会将该服务中的响应序列化为JSONstring。 对于VB6是否存在JSONparsing器？
查看JSON.org获取JSONparsing器的最新列表（请参阅主页底部）。 截至撰写本文时，您将看到指向两个不同JSONparsing器的链接：
-
VB-JSON
- 当我试图下载zip文件时，Windows表示数据已损坏。 但是，我可以使用7-zip将文件拖出。 事实certificate，压缩文件中的主“文件夹”不被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") - 注意：我必须通过VBA编辑器中的工具>参考添加“Microsoft Scripting Runtime”和“Microsoft ActiveX Data Objects 2.8”库作为参考。
- 注意：VBJSON代码实际上是基于一个谷歌代码项目vba-json 。 但是，VBJSON承诺从原始版本修复一些错误。
- PW.JSON
- 这实际上是VB.NET的一个库，所以我没有花太多的时间去研究它。
build立在ozmike解决scheme，这不适合我（Excel 2013和IE10）。 原因是我无法调用公开的JSON对象上的方法。 所以它的方法现在通过附属于DOME元素的function而暴露出来。 不知道这是可能的（必须是那个IDispatch的东西），谢谢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
以下testing从头开始构build一个JavaScript对象，然后对其进行string化。 然后它parsing对象并迭代其键。
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
我知道这是一个老问题，但是我的回答希望能够帮助那些在search“vba json”后继续访问此页面的人。
我发现这个页面非常有帮助。 它提供了几个Excel兼容的VBA类，用于处理JSON格式的数据。
这是一个“本机”VB JSON库。
可以使用已经在IE8 +中的JSON。 这样，你不依赖于第三方库过时，没有经过testing。
在这里看到amedeus的替代版本
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。
创build一个函数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
如果您觉得有用，请投票
Tim Hall， MIT许可和GitHub上的 VBA-JSON 。 这是2014年年底出现的另一个vba-json分支。声称在Mac Office和Windows 32bit和64bit上工作。
这次派对迟到了，但是很抱歉，最简单的方法就是使用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相关主题的问答。
Q1 在Windows上的Excel VBA中，如何缓解IDE大小写行为破坏的parsingJSON的点语法遍历问题？
Q2 在Windows上的Excel VBA中，如何通过parsing的JSON数组循环？
Q3 在Windows的Excel VBA中，如何获得string化的JSON表示而不是“[object object]”来parsingJSONvariables？
Q4 在Windows Excel VBA中，如何获取JSON密钥以预先取得“运行时错误438”：对象不支持此属性或方法“？
Q5 在Windows的Excel VBA中，对于parsing的JSONvariables，这个JScriptTypeInfo是什么？
VB6 – JsonBag，另一个JSONparsing器/发生器也应该可以导入到VBA中， 而不会有麻烦。
我会build议使用.Net组件。 您可以通过Interop使用VB6中的.Net组件 – 这里有一个教程 。 我的猜测是，.Net组件将比VB6的任何产品更可靠和更好的支持。
Microsoft.Net框架中的组件如DataContractJsonSerializer或JavaScriptSerializer 。 你也可以使用第三方库，如JSON.NET 。
你可以在VB.NET中编写一个Excel-DNA加载项。 Excel-DNA是一个可以让你在.NET中编写XLL的精简库。 通过这种方式，您可以访问整个.NET Universe，并可以使用像http://james.newtonking.com/json这样的东西; – 一个JSON框架，可以在任何自定义类中对JSON进行反序列化。
如果你有兴趣，下面写一个如何使用VB.NET为Excel创build一个通用的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
使用parsingJSON的JavaScript特性，在ScriptControl之上，我们可以在VBA中创build一个parsing器，它将列出JSON中的每个数据点。 无论数据结构如何嵌套或复杂，只要我们提供有效的JSON，这个parsing器将返回一个完整的树结构。
JavaScript的Eval，getKeys和getProperty方法提供了用于validation和读取JSON的构build块。
结合VBA中的recursion函数，我们可以遍历JSONstring中的所有关键字（高达第n级）。 然后使用一个Tree控件（本文中使用）或一个字典，甚至是一个简单的工作表，我们可以根据需要安排JSON数据。
完整的VBA代码在这里。使用parsingJSON的JavaScript特性，在ScriptControl之上，我们可以在VBA中创build一个parsing器，它将列出JSON中的每个数据点。 无论数据结构如何嵌套或复杂，只要我们提供有效的JSON，这个parsing器将返回一个完整的树结构。
JavaScript的Eval，getKeys和getProperty方法提供了用于validation和读取JSON的构build块。
结合VBA中的recursion函数，我们可以遍历JSONstring中的所有关键字（高达第n级）。 然后使用一个Tree控件（本文中使用）或一个字典，甚至是一个简单的工作表，我们可以根据需要安排JSON数据。
完整的VBA代码在这里。
公式在一个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步。 插入 – >模块
- 第三步。 工具 – >引用 – >勾选Microsoft Script Control 1.0
- 步骤4。 粘贴下面。
- 第五步。 ALT + QclosuresVBA窗口。
'Tools->References-> '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
由于Json只是string，所以无论结构多么复杂，如果我们可以正确地操作它，它就可以很容易地处理。 我不认为有必要使用任何外部库或转换器来伎俩。 这是一个例子，我已经使用string操作parsing了json数据。
Sub Json_coder() 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) Cells(y, 5) = Split(Split(itm(y), "suite"": """)(1), """")(0) Cells(y, 6) = Split(Split(itm(y), "city"": """)(1), """")(0) Cells(y, 7) = Split(Split(itm(y), "zipcode"": """)(1), """")(0) Cells(y, 8) = Split(Split(itm(y), "phone"": """)(1), """")(0) Cells(y, 9) = Split(Split(itm(y), "website"": """)(1), """")(0) Cells(y, 10) = Split(Split(Split(itm(y), "company"": ")(1), "name"": """)(1), """")(0) Cells(y, 11) = Split(Split(itm(y), "catchPhrase"": """)(1), """")(0) Cells(y, 12) = Split(Split(itm(y), "bs"": """)(1), """")(0) Next y End Sub
