一、下面我们先来了解一下什么是JSON?(JSON 教程_w3cschool)
JSON(JavaScript Object Notation) 是一种轻量级的数据交换格式。它基于ECMAScript的一个子集。JSON采用完全独立于语言的文本格式，但是也使用了类似于C语言家族的习惯（包括C、C 、C#、Java、JavaScript、Perl、Python等）。这些特性使JSON成为理想的数据交换语言。易于人阅读和编写，同时也易于机器解析和生成(一般用于提升网络传输速率)。
从Web API和服务端编程语言到NoSQL数据库和客户端框架，都有JSON的身影。在不同平台间传递数据方面，JSON已成为XML强有力的替代者。
二、好了,我们已经了解了它的一些特性和优势后,下面来说说,怎么通过VBA/VB6去解析JSON呢?
细心的朋友会发现,其实以前就已经发过相关的文章,只是没有针对JSON做详细说明,文章地址(VB6 调用谷歌翻译API进行文章单词翻译)
大家都知道VBA/VB6对JSON的支持是非常不友好的,毕竟JSON是后起之秀,既然JSON是JavaScript的一种数据常用结构,那么我们可不可在VBA/6中,通过JS脚本的方式编译得到VB对象呢?显然是可以的,今天的主角就是它;
三、接下来我们，对JSON对象和JSON字符串进行解析；
3.1.JSON对象长这样
代码语言：javascript复制{
"状态": 0,
"信息": "查询成功",
"结果": [{
"姓名": "张三",
"年龄": 18,
"身高": 165,
"体重": "66KG",
"爱好": "打球,瞟美女"
}, {
"姓名": "李四",
"年龄": 20,
"身高": 175,
"体重": "70KG",
"爱好": "瞟美女",
"喜欢的美女": [{
"姓名": "玲玲",
"身高": 165,
"体重": "48KG"
}, {
"姓名": "婷婷",
"身高": 170,
"体重": "45KG"
}
]
}, {
"姓名": "王五",
"年龄": 22,
"身高": 185,
"体重": "60KG",
"爱好": "看隔壁美女",
"喜欢美女类型": ["御姐", "萝莉", "少妇"]
}
]
}
3.2.JSON字符串长这样
代码语言：javascript复制"{
"状态": 0,
"信息": "查询成功",
"结果": [{
"姓名": "张三",
"年龄": 18,
"身高": 165,
"体重": "66KG",
"爱好": "打球,瞟美女"
}, {
"姓名": "李四",
"年龄": 20,
"身高": 175,
"体重": "70KG",
"爱好": "瞟美女",
"喜欢的美女": [{
"姓名": "玲玲",
"身高": 165,
"体重": "48KG"
}, {
"姓名": "婷婷",
"身高": 170,
"体重": "45KG"
}
]
}, {
"姓名": "王五",
"年龄": 22,
"身高": 185,
"体重": "60KG",
"爱好": "看隔壁美女",
"喜欢美女类型": ["御姐", "萝莉", "少妇"]
}
]
}"
3.4.先来解析JSON对象；
先用json与VB对象做个对比吧，方便解释；在json中花括号{}括起来的我们可以理解成VB中字典对象，中括号[]括起来的我们可以把它理解VB中数组对象；
先上json对象解析代码
代码语言：javascript复制Public Function JsonObjToVbObject(sjson As String) As Object
On Error GoTo er:
Dim jsonobj As Object
With CreateObject("msscriptcontrol.scriptcontrol")
.Language = "JavaScript"
.addcode "var jsonobj=" & sjson
Set jsonobj = .codeobject
End With
Set JsonObjToVbObject = jsonobj
Exit Function
er:
Set JsonObjToVbObject = Nothing
End Function3.5.使用实列
代码语言：javascript复制Sub test1()
Dim SJS As String: SJS = "{'状态':0,'信息':'查询成功','结果':[{'姓名':'张三','年龄':18,'身高':165,'体重':'66KG','爱好':'打球,瞟美女'},{'姓名':'李四','年龄':20,'身高':175,'体重':'70KG','爱好':'瞟美女','喜欢的美女':[{'姓名':'玲玲','身高':165,'体重':'48KG'},{'姓名':'婷婷','身高':170,'体重':'45KG'}]},{'姓名':'王五','年龄':22,'身高':185,'体重':'60KG','爱好':'看隔壁美女','喜欢美女类型':['御姐','萝莉','少妇']}]}"
Set VBOBJ = JsonObjToVbObject(SJS)
End Sub
3.5.1.下面我们来尝试取，第一层里面的“信息”的值，只需要以下操作即可
代码语言：javascript复制Debug.Print VBOBJ.jsonobj.信息
3.5.2.下面我们来单独取，“结果”中，“李四”的“爱好”，这里用到了“CallByName”，因为JScriptTypeInfo对象不予许直接点属性
代码语言：javascript复制 Set 结果集 = VBOBJ.jsonobj.结果
Set 李四 = CallByName(结果集, "1", VbGet)
Debug.Print 李四.爱好
3.5.2.下面再看看怎么取出李四喜欢的美女的信息
代码语言：javascript复制 Set 结果集 = VBOBJ.jsonobj.结果
Set 李四 = CallByName(结果集, "1", VbGet)
For Each 李四喜欢的美女 In 李四.喜欢的美女
Debug.Print 李四喜欢的美女.姓名
Debug.Print 李四喜欢的美女.身高
Next
3.5.3.取相同王五兄弟的喜欢的美女类型与上面的方法一样
代码语言：javascript复制 Set 结果集 = VBOBJ.jsonobj.结果
Set 王五兄弟 = CallByName(结果集, "2", VbGet)
For Each 美女类型 In 王五兄弟.喜欢美女类型
Debug.Print 美女类型
Next
3.5.4.那么直接取出这几位兄弟的所有信息怎么操作呢？
代码语言：javascript复制 For Each 信息 In 结果集 ''取字典类型
Debug.Print 信息.姓名
Debug.Print 信息.年龄
Debug.Print 信息.身高
Debug.Print 信息.体重
Debug.Print 信息.爱好
If 信息.姓名 = "李四" Then ''取字典类型
For Each 李四 In 信息.喜欢的美女
Debug.Print " 李四喜欢的美女:" & 李四.姓名
Debug.Print " 李四喜欢的美女:" & 李四.身高
Next
ElseIf 信息.姓名 = "王五" Then '去数组类型
For Each 王五 In 信息.喜欢美女类型
Debug.Print " 王五喜欢的美女类型:" & 王五
Next
End If
Next
3.6.json字符串解析代码（取信息与json对象方法相同，不做演示）
代码语言：javascript复制Public Function JsonStrToVbObject(sjson As String) As Object
On Error GoTo er:
Dim jsonobj As Object
With CreateObject("msscriptcontrol.scriptcontrol")
.Language = "JavaScript"
.addcode "var jstr=" & sjson & ";var jsonobj= eval('(' jstr ')');"
Set jsonobj = .codeobject
End With
Set JsonStrToVbObject = jsonobj
Exit Function
er:
Set JsonStrToVbObject = Nothing
End Function
完整测试代码
代码语言：javascript复制'json对象转VB对象
Public Function JsonObjToVbObject(sjson As String) As Object
On Error GoTo er:
Dim jsonobj As Object
With CreateObject("msscriptcontrol.scriptcontrol")
.Language = "JavaScript"
.addcode "var jsonobj=" & sjson
Set jsonobj = .codeobject
End With
Set JsonObjToVbObject = jsonobj
Exit Function
er:
Set JsonObjToVbObject = Nothing
End Function
'json字符串转VB对象
Public Function JsonStrToVbObject(sjson As String) As Object
On Error GoTo er:
Dim jsonobj As Object
With CreateObject("msscriptcontrol.scriptcontrol")
.Language = "JavaScript"
.addcode "var jstr=" & sjson & ";var jsonobj= eval('(' jstr ')');"
Set jsonobj = .codeobject
End With
Set JsonStrToVbObject = jsonobj
Exit Function
er:
Set JsonStrToVbObject = Nothing
End Function
Sub test1()
Dim SJS As String: SJS = "{'状态':0,'信息':'查询成功','结果':[{'姓名':'张三','年龄':18,'身高':165,'体重':'66KG','爱好':'打球,瞟美女'},{'姓名':'李四','年龄':20,'身高':175,'体重':'70KG','爱好':'瞟美女','喜欢的美女':[{'姓名':'玲玲','身高':165,'体重':'48KG'},{'姓名':'婷婷','身高':170,'体重':'45KG'}]},{'姓名':'王五','年龄':22,'身高':185,'体重':'60KG','爱好':'看隔壁美女','喜欢美女类型':['御姐','萝莉','少妇']}]}"
Set VBOBJ = JsonObjToVbObject(SJS)
Set 结果集 = VBOBJ.jsonobj.结果
For Each 信息 In 结果集 ''取字典类型
Debug.Print 信息.姓名
Debug.Print 信息.年龄
Debug.Print 信息.身高
Debug.Print 信息.体重
Debug.Print 信息.爱好
If 信息.姓名 = "李四" Then ''取字典类型
For Each 李四 In 信息.喜欢的美女
Debug.Print " 李四喜欢的美女:" & 李四.姓名
Debug.Print " 李四喜欢的美女:" & 李四.身高
Next
ElseIf 信息.姓名 = "王五" Then '去数组类型
For Each 王五 In 信息.喜欢美女类型
Debug.Print " 王五喜欢的美女类型:" & 王五
Next
End If
Next
End Sub
Sub test2()
Dim SJS As String: SJS = """{""状态"":0,""信息"":""查询成功"",""结果"":[{""姓名"":""张三"",""年龄"":18,""身高"":165,""体重"":""66KG"",""爱好"":""打球,瞟美女""},{""姓名"":""李四"",""年龄"":20,""身高"":175,""体重"":""70KG"",""爱好"":""瞟美女"",""喜欢的美女"":[{""姓名"":""玲玲"",""身高"":165,""体重"":""48KG""},{""姓名"":""婷婷"",""身高"":170,""体重"":""45KG""}]},{""姓名"":""王五"",""年龄"":22,""身高"":185,""体重"":""60KG"",""爱好"":""看隔壁美女"",""喜欢美女类型"":[""御姐"",""萝莉"",""少妇""]}]}"""
Set VBOBJ = JsonStrToVbObject(SJS)
Set 结果集 = VBOBJ.jsonobj.结果
For Each 信息 In 结果集 ''取字典类型
Debug.Print 信息.姓名
Debug.Print 信息.年龄
Debug.Print 信息.身高
Debug.Print 信息.体重
Debug.Print 信息.爱好
If 信息.姓名 = "李四" Then ''取字典类型
For Each 李四 In 信息.喜欢的美女
Debug.Print " 李四喜欢的美女:" & 李四.姓名
Debug.Print " 李四喜欢的美女:" & 李四.身高
Next
ElseIf 信息.姓名 = "王五" Then '去数组类型
For Each 王五 In 信息.喜欢美女类型
Debug.Print " 王五喜欢的美女类型:" & 王五
Next
End If
Next
End Sub
哎！乱七八槽，就这样吧！不知道你们懂了没，反正我懂了！
