【VBA研究】解析JSON数据的几种方法

【VBA研究】解析JSON数据的⼏种⽅法

iamlaosong⽂

⽹抓数据或者通过接⼝接收数据时，发来的数据很多是JSON格式，这是JavaScript常⽤的⼀种数据结构。对这种数据如何解析呢？先假定

发来的数据如下，并针对这个数据给出⼏种解析⽅法写成的函数：

'返回数据（json格式）

'{"traces":[

'{"acceptTime":"2016-12-03 12:24:25","acceptAddress":"宿州市","remark":"宿州市邮政速递公司北区揽投部已收件（揽投员姓名：陆登杰，:189******** '{"acceptTime":"2016-12-03 18:45:11","acceptAddress":"宿州市","remark":"离开宿州市发往蚌埠市"},

'{"acceptTime":"2016-12-03 21:13:10","acceptAddress":"蚌埠市","remark":"到达蚌埠市处理中⼼（经转）"},

'{"acceptTime":"2016-12-03 21:14:29","acceptAddress":"蚌埠市","remark":"离开蚌埠市发往南京市（经转）"},

'{"acceptTime":"2016-12-04 01:31:00","acceptAddress":"南京市","remark":"到达EMS航空集散中⼼（南京）处理中⼼（经转）"},

'{"acceptTime":"2016-12-04 06:34:00","acceptAddress":"南京市","remark":"离开南京市发往北京市（经转）"},

'{"acceptTime":"2016-12-04 08:39:00","acceptAddress":"北京市","remark":"到达中国邮政速递物流股份有限公司北京市邮件处理中⼼（航处理中⼼"},

'{"acceptTime":"2016-12-04 11:22:04","acceptAddress":"北京市","remark":"离开中国邮政速递物流股份有限公司北京市国货航航空邮件处发往北京邮政速递上地区 '{"acceptTime":"2016-12-04 13:23:00","acceptAddress":"北京市","remark":"北京邮政速递上地区域分公司清华营投部安排投递，预计23:59:00前投递"},

'{"acceptTime":"2016-12-04 15:50:40","acceptAddress":"北京市","remark":"投递并签收，签收⼈：本⼈收"}]}

1、⽤instr函数，这是我最早想到的办法，当然很⼟很暴⼒啦

'⽤instr函数，从字符串中取出轨迹信息，返回条数

Function get_trace(mystring As String) As Integer

Dim m1, m2, m3, m4, n, sn As Integer

Dim buf As String

buf = mystring

sn = 1

tt = "no"

For n = 1 To 80

m1 = InStr(sn, buf, "acceptTime", vbTextCompare)

If m1 = 0 Then Exit For

m2 = InStr(sn, buf, "acceptAddress", vbTextCompare)

m3 = InStr(sn, buf, "remark", vbTextCompare)

m4 = InStr(sn, buf, "}", vbTextCompare)

stime(n) = Mid(buf, m1 + 13, 20)

saddr(n) = Mid(buf, m2 + 16, m3 - m2 - 19)

state(n) = Mid(buf, m3 + 9, m4 - m3 - 10)

sn = m4 + 2

Next n

If Left(state(n - 1), 2) = "妥投" Or Left(state(n - 1), 5) = "投递并签收" Then tt = "OK"

get_trace = n - 1

End Function

2、⽤split函数，稍微聪明⼀点，依然有点暴⼒

' ⽤split函数，调试成功，可以使⽤

Function get_trace_split(mystring As String) As Integer

Dim buf1, buf2

Dim n As Integer

tt = "no"

buf1 = Split(mystring, "{")

For n = 2 To UBound(buf1)

buf2 = Split(Left(buf1(n), InStr(buf1(n), "}") - 1), ",")

stime(n - 1) = Split(buf2(0), """")(3) '因为时间中有冒号，所以不能⽤它做分隔符，改⽤引号

saddr(n - 1) = Split(buf2(1), """")(3)

state(n - 1) = Split(buf2(2), """")(3)

'Debug.Print stime(n - 1) & saddr(n - 1) & state(n - 1)

Next n

If Left(state(n - 2), 2) = "妥投" Or Left(state(n - 2), 5) = "投递并签收" Then tt = "OK"

get_trace_split = n - 2

End Function

3、⽤ScriptControl对象，把数据交给JavaScript处理，这才是正确的⽅法

JSON格式的最⼤优点是它可以被很容易得被转换为⼀个JS对象。将JSON数据赋给⼀个变量或者放⼊表达式中计算都可以转换为JS对象。下⾯就是利⽤表达式计算返回⼀个JS对象，再分别取属性值既可。

'⽤ScriptControl对象，调试成功，可以使⽤

'Microsoft Script 控件可作为⼀个控件或者作为⼀个独⽴的 Automation 对象创建出来。

'Microsoft Script 控件使⽤户可以创建⼀个运⾏ scripting 语⾔(如VBScript或JScript)的应⽤程序。

Function get_trace_json(mystring As String) As Integer

Dim objJSx, objJSy As Object

Set objJSx = CreateObject("ScriptControl") '调⽤MSScriptControl.ScriptControl对象将提取的变量⽂本运算形成对象集合

objJSx.Language = "JavaScript" '测试发现JavaScript、javascript、JScript都可以表⽰JavaScript语⾔

'定义⼀个JS函数，通过计算表达式的⽅式引⼊JSON数据并解析

jscode = "function json(s,i) { return eval('(' + s + ').traces[' + i + ']'); }"

objJSx.AddCode jscode

For n = 1 To 80

If objJSx.Run("json", mystring, n - 1) = "" Then Exit For

Set objJSy = objJSx.Run("json", mystring, n - 1)

stime(n) = objJSy.acceptTime

saddr(n) = objJSy.acceptAddress

state(n) = ark

Debug.Print n & ":" & objJSy.acceptTime & objJSy.acceptAddress & ark

Next n

If Left(state(n - 1), 2) = "妥投" Or Left(state(n - 1), 5) = "投递并签收" Then tt = "OK"

get_trace_json = n - 1

End Function

直接⽤JS对象的eval⽅法也可，特别是单条记录。看下⾯程序：

Sub get_json()

Dim arrJson

Dim objJSx As Object, objJSy As Object

Set objJSx = CreateObject("ScriptControl")

objJSx.Language = "JScript"

arrJson = "{""myname"":""iamlaosong"",""myaddress"":{""city"":""HeFei"",""street"":"" Huangshan Road "",""postcode"":230088}}"

Set objJSy = objJSx.eval("eval(" & arrJson & ")")

ame

address

address.city

address.postcode

End Sub

4、交给JavaScript处理，换⼀种写法，虽然不见得⽐上⾯的⽅法好。

下⾯是通过将JSON数据赋给⼀个变量转换为JS对象，可以直接取属性值，也可以⽤CallByName函数取属性值。

'⽤ScriptControl对象，⼀旦对象⽤熟，就可以有多种写法，下⾯是另⼀种，取数也可以⽤CallByName函数

Function get_trace_json1(mystring As String) As Integer

Dim objJSx, objJSy As Object

Set objJSx = CreateObject("ScriptControl") '调⽤MSScriptControl.ScriptControl对象将提取的变量⽂本运算形成对象集合

objJSx.Language = "JavaScript" '测试发现JavaScript、javascript、JScript都可以表⽰JavaScript语⾔

jscode = "var json=" & mystring & ";" '定义⼀个JS变量，将JSON数据引⼊

objJSx.AddCode (jscode)

For n = 1 To 80

jscode = "var json_aces[" & n - 1 & "];" '再定义⼀个JS变量，取出前⾯引⼊数组的⼀个元素，实际就是利⽤JS对数据进⾏解析 objJSx.AddCode (jscode)

If objJSx.CodeObject.json_tr = "" Then Exit For

Set objJSy = objJSx.CodeObject.json_tr

stime(n) = CallByName(objJSy, "acceptTime", VbGet)

saddr(n) = CallByName(objJSy, "acceptAddress", VbGet)

state(n) = CallByName(objJSy, "remark", VbGet)

Debug.Print n & ":" & objJSy.acceptTime & objJSy.acceptAddress & ark

acceptlanguageNext n

If Left(state(n - 1), 2) = "妥投" Or Left(state(n - 1), 5) = "投递并签收" Then tt = "OK"

get_trace_json1 = n - 1

End Function

5、还是交给JavaScript处理，这⼀次换个对象，⽤HTMLfile

'⽤HTMLfile对象，其实也是利⽤JScript语⾔解析JSON格式数据

Function get_trace_html(mystring As String) As Integer

Dim objHTML, objJSy, objWin As Object

Set objHTML = CreateObject("htmlfile")

Set objWin = objHTML.parentWindow