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處理簡單。
![【VBA研究】利用ADO讓普通人用excel讀取oracle資料庫表的通用辦法[圖]](data:image/gif;base64,R0lGODlhAQABAIAAAP///wAAACwAAAAAAQABAAACAkQBADs=)