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
 

' 用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

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

'用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