是否有适用于VB6 / VBA的JSON解析器？-Java 学习之路

我试图在VB6中使用Web服务 . 我控制的服务 - 当前可以返回SOAP / XML消息或JSON . 我很难弄清楚VB6的SOAP类型（版本1）是否可以处理返回的 object - 而不是像 string ， int 这样的简单类型 . 到目前为止，我无法弄清楚我需要做什么才能让VB6进入玩回归的物体 .

所以我想我可能会将Web服务中的响应序列化为JSON字符串 . VB6是否存在JSON解析器？

13 回答

4
查看JSON.org以获取许多不同语言的JSON解析器的最新列表（请参阅主页的底部） . 截至撰写本文时，您将看到两个不同JSON解析器的链接：
- VB-JSON
- 当我尝试下载zip文件时，Windows表示数据已损坏 . 但是，我能够使用7-zip将文件拉出来 . 事实证明，zip文件中的主"folder"不被Windows识别为文件夹，7-zip可以看到主"folder,"的内容，因此您可以打开它然后相应地提取文件 .
- 这个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 的库，所以我没有花太多时间研究它 .
回复于 2024-04-29T04:01:04+08:00
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数据 .

Full VBA Code here.

回复于 2024-04-29T04:01:04+08:00

以ozmike解决方案为基础，这对我不起作用（Excel 2013和IE10） . 原因是我无法在公开的JSON对象上调用方法 . 因此，它的方法现在通过附加到DOMElement的函数公开 . 不知道这是可能的（必须是IDispatch-thing），谢谢你 .

正如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

回复于 2024-04-29T04:01:04+08:00

3

我知道这是一个古老的问题，但我的回答对希望在搜索“vba json”之后继续访问此页面的其他人有很大的帮助 .

我发现这个page非常有帮助 . 它提供了几个与Excel兼容的VBA类，用于处理JSON格式的数据处理 .

回复于 2024-04-29T04:01:04+08:00
2
UPDATE: Found a safer way of parsing JSON than using Eval, this blog post shows the dangers of 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相关的主题 .

Q1 In Excel VBA on Windows, how to mitigate issue of dot syntax traversal of parsed JSON broken by IDE's capitalisation behaviour?

Q2 In Excel VBA on Windows, how to loop through a JSON array parsed?

Q3 In Excel VBA on Windows, how to get stringified JSON respresentation instead of “[object Object]” for parsed JSON variables?

Q4 In Windows Excel VBA,how to get JSON keys to pre-empt “Run-time error '438': Object doesn't support this property or method”?

Q5 In Excel VBA on Windows, for parsed JSON variables what is this JScriptTypeInfo anyway?
回复于 2024-04-29T04:01:04+08:00

这是一个“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

如果您觉得有用，请进行投票

回复于 2024-04-29T04:01:04+08:00

4

VBA-JSON 由蒂姆·霍尔， MIT licensed 和 GitHub . 它是2014年底出现的另一个vba-json的分支 . 声称可以在Mac Office和Windows 32bit和64bit上运行 .

回复于 2024-04-29T04:01:04+08:00
39

VB6 - JsonBag, Another JSON Parser/Generator也应该可以输入VBA而不会有任何问题 .

回复于 2024-04-29T04:01:04+08:00
0

我建议使用.Net组件 . 您可以通过Interop使用VB6中的.Net组件 - 这是tutorial . 我的猜测是.Net组件比VB6生成的任何组件都更可靠，支持更好 .

Microsoft .Net框架中有一些组件，如DataContractJsonSerializer或JavaScriptSerializer . 您也可以使用第JSON.NET等第三方库 .

回复于 2024-04-29T04:01:04+08:00
5

您可以在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

回复于 2024-04-29T04:01:04+08:00

这是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

回复于 2024-04-29T04:01:04+08:00

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

说明：
Step1 . 按ALT F11
Step2 . 插入 - >模块
Step3 . 工具 - >引用 - >勾选Microsoft Script Control 1.0
Step4 . 粘贴如下 .
Step5 . 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

回复于 2024-04-29T04:01:04+08:00

由于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

回复于 2024-04-29T04:01:04+08:00

是否有适用于VB6 / VBA的JSON解析器？

13 回答

相关问题