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

iamlaosong文

网抓数据或者通过接口接收数据时,发来的数据很多是JSON格式,这是JavaScript常用的一种数据结构。对这种数据如何解析呢?先假定发来的数据如下,并针对这个数据给出几种解析方法写成的函数:

 

'返回数据(json格式)
    '{"traces":[
    '{"acceptTime":"2016-12-03 12:24:25","acceptAddress":"宿州市","remark":"宿州市邮政速递公司北区揽投部已收件(揽投员姓名:陆登杰,联系电话:18955780863)"},
    '{"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) = objJSy.remark
        Debug.Print n & ":" & objJSy.acceptTime & objJSy.acceptAddress & objJSy.remark
    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 & ")")
    MsgBox objJSy.myname
    MsgBox objJSy.myaddress
    MsgBox objJSy.myaddress.city
    MsgBox objJSy.myaddress.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_tr=json.traces[" & 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 & objJSy.remark
    Next 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
    objWin.execScript "var json = " & mystring, "JScript"     '定义一个JS变量,将JSON数据引入
    For n = 1 To 80
         '再定义一个JS变量,取出前面引入数组的一个元素,实际就是利用JS对数据进行解析
        objWin.execScript "var json_tr = json.traces[" & n - 1 & "];", "JScript"
        If objWin.json_tr = "" Then Exit For
        Set objJSy = objWin.json_tr
    
        stime(n) = objJSy.acceptTime
        saddr(n) = objJSy.acceptAddress
        state(n) = objJSy.remark
        Debug.Print n & ":" & objJSy.acceptTime & objJSy.acceptAddress & objJSy.remark
    Next n
    
    If Left(state(n - 1), 2) = "妥投" Or Left(state(n - 1), 5) = "投递并签收" Then tt = "OK"
    get_trace_html = n - 1
End Function


最后,可能有人说还可以用正则表达式处理,如用VBSCRIPT.REGEXP对象。这种方法是可以处理,可是需要根据数据写正则表达式,哪有交个JavaScript处理简单。

 

评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值