VBA / 抓取網路 JSON資料 版本3

 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  
'       }
'     }"

 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

 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