之前有2篇記錄在Excel VBA分割Json資料的方式
原理都是把Json資料當作字串,使用分割字串的函式進行
後來在網路上看到有人提供轉換Json資料的VBA模組 VBA-JSON
使用這個外掛模組就可以把Json資料轉變成VBA物件,可以利用方法(Methods)、屬性(Properties)來取得資料數量或者key名稱、value值
安裝的方式如下
1.匯入 BAS檔
2.引用 Microsoft Scripting Runtime
作者提供了基本的操作說明
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25 | Dim Json As Object
Set Json = JsonConverter.ParseJson("{""a"":123,""b"":[1,2,3,4],""c"":{""d"":456}}")
' Json("a") -> 123
' Json("b")(2) -> 2
' Json("c")("d") -> 456
Json("c")("e") = 789
Debug.Print JsonConverter.ConvertToJson(Json)
' -> "{"a":123,"b":[1,2,3,4],"c":{"d":456,"e":789}}"
Debug.Print JsonConverter.ConvertToJson(Json, Whitespace:=2)
' -> "{
' "a": 123,
' "b": [
' 1,
' 2,
' 3,
' 4
' ],
' "c": {
' "d": 456,
' "e": 789
' }
' }"
|
也提供了解析Json的小撇步-How to parse JSON with VBA-JSON
將要解析的Json資料貼在Json Parser Online
可以很清楚地顯示Json檔案的架構
這樣可以方便設定目標資料的位置
第一個練習是抓取一般常見的Json格式,也就是{ key : value}對應的型態
目標資料在 records 裡,也是{ key : value}對應的型態

Const URl As String = "https://data.epa.gov.tw/api/v1/aqx_p_432?limit=1000&api_key=9be7b239-557b-4c10-9775-78cadfc555e9&format=json"
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48 | 'Json裡有多筆資料
'抓取其中一個項目裡的資料
Public Sub test()
'刪除舊資料
Sheets(1).Select
Cells.Select
Selection.ClearContents
Range("A1").Select
'設定 XMLHTTP 物件
Dim xmlHttp As Object
Set xmlHttp = CreateObject("MSXML2.ServerXMLHTTP.6.0")
xmlHttp.Open "GET", URl, False
xmlHttp.send
S = xmlHttp.responseText '回傳資料內容
' Debug.Print S
'
Dim Parsed As Object
Set Parsed = JsonConverter.ParseJson(S)
' Debug.Print Parsed("records").Count 'records的資料筆數
' Debug.Print Parsed("records")(2)("SiteName") '在records裡的第2筆資料中的SiteName
' arr = Parsed("records")(2).Keys
' Debug.Print arr(0)
Title = Parsed("records")(1).Keys
'Debug.Print Title(0)
For t = 1 To Parsed("records")(1).Count
Cells(1, t) = Title(t - 1)
Next
For i = 1 To Parsed("records").Count ' records的筆數 85
For j = 1 To Parsed("records")(1).Count 'records的項目名稱數 25
arr = Parsed("records")(1).Keys
' Debug.Print Parsed("records")(i)(arr(j - 1))
Cells(i + 1, j) = Parsed("records")(i)(arr(j - 1))
Next
Next
Set xmlHttp = Nothing
End Sub
|
#30-#34
這個for迴圈取得資料欄位─也就是Key值
#36-#44
透過外迴圈─逐一取出records裡的每一筆資料
在內迴圈─取出資料的key值(因為每一筆的key值都一樣,所以直接用第1筆)帶入取得對應的value值
這裡要注意的是JsonConverter.ParseJson()轉換後的資料,第1筆的Index值是從1開始
而VBA的陣列(例如程式裡的arr─儲存Parsed(“records”)(1).Keys─第1筆資料的所有key值),第1筆的Index值是從0開始
這個程式可以回傳符合查詢項目的Json資料

Json格式是 [{“dataload”:[“時間戳記”,”電子郵件地址”,”姓名”,”單選題”,”寄出確認信”]},[{“dataload”:[…]},…]
也就是vaule是陣列型態資料
第1筆資料是欄位名稱,之後的筆數都是資料內容

Const URl2 As String = "https://script.google.com/macros/s/AKfycbwxkgntkYF25Kk2Khdgn0bSLqxhHvDTRiRTfwJTfTuX4BQzOrpOImxccrRuTWvBZhMXHw/exec?mailID=trico109748007@gmail.com.tw"
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41 | 'Json資料是陣列格式
'
Public Sub test2()
'刪除舊資料
Sheets(2).Select
Cells.Select
Selection.ClearContents
Range("A1").Select
'設定 XMLHTTP 物件
Dim xmlHttp As Object
Set xmlHttp = CreateObject("MSXML2.ServerXMLHTTP.6.0")
xmlHttp.Open "GET", URl2, False
xmlHttp.send
S = xmlHttp.responseText '回傳資料內容
Dim Parsed As Object
Set Parsed = JsonConverter.ParseJson(S)
'' Debug.Print Parsed.Count 'Parsed的資料數 3
' k = Parsed(1).Keys
' Debug.Print k(0) 'dataload
' Debug.Print UBound(k) '0 ->有1筆
' v = Parsed(1).Items
' Debug.Print v(0).Count '5筆
' Debug.Print v(0)(1) '第1筆項目名稱 "時間戳記"
' Debug.Print UBound(v) '0 ->有1筆
' Debug.Print Parsed(1)("dataload").Count 'dataload裡的資料數 5
' Debug.Print Parsed(1)("dataload")(1) 'dataload裡的第1筆資料 "時間戳記"
For i = 1 To Parsed.Count
For j = 1 To Parsed(i)("dataload").Count
Cells(i, j) = Parsed(i)("dataload")(j)
Next
Next
Set xmlHttp = Nothing
End Sub
|
#34-#38
透過外迴圈─逐一所有筆數的資料
透過內迴圈─逐一取出單一筆資料內的所有資料
基本上就是要搞清楚Json資料的架構,才能夠設計出相對應的迴圈程式來取得所有的目標資料
參考資料
VBA-JSON
How to parse JSON with VBA-JSON
Json Parser Online