EXCEL VBA抓取网页JSON数据并解析

链接地址：
https://api.api68.com/CQShiCai/getBaseCQShiCaiList.do?lotCode=10036&date=2024-01-26

Sub test()
On Error Resume Next
Sheet.Select
Sheet1.Cells.ClearContents
[a1:g1] = Split("preDrawIssue|preDrawTime|preDrawCode 1|preDrawCode 2|preDrawCode 3|preDrawCode 4|preDrawCode 5", "|")Dim t As ObjectSet t = CreateObject("ScriptControl")t.Language = "JScript"sj = Format(Now, "yyyy-mm-dd")Dim xmlhttp As ObjectSet xmlhttp = CreateObject("winhttp.winhttprequest.5.1")With xmlhttp.Open "GET", "https://api.api68.com/CQShiCai/getBaseCQShiCaiList.do?lotCode=10036&date=" & sj, False.SetRequestHeader "Host", "api.api68.com".SetRequestHeader "Connection", "keep-alive".SetRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; WOW64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/69.0.3947.100 Safari/537.36".Sendstrtext = .responseTextSet y = t.eval("eval(" & strtext & ")")End WithFor i = 0 To 5000If CallByName(CallByName(CallByName(CallByName(y, "result", VbGet), "data", VbGet), i, VbGet), "preDrawIssue", VbGet) = Empty Then Exit SubCells(2 + i, 1) = CallByName(CallByName(CallByName(CallByName(y, "result", VbGet), "data", VbGet), i, VbGet), "preDrawIssue", VbGet)Cells(2 + i, 2) = CallByName(CallByName(CallByName(CallByName(y, "result", VbGet), "data", VbGet), i, VbGet), "preDrawTime", VbGet)arr = Split(CallByName(CallByName(CallByName(CallByName(y, "result", VbGet), "data", VbGet), i, VbGet), "preDrawCode", VbGet), ",")Cells(2 + i, 3) = arr(0)Cells(2 + i, 4) = arr(1)
Cells(2 + i, 5) = arr(2)
Cells(2 + i, 6) = arr(3)
Cells(2 + i, 7) = arr(4)DoEventsNext
End Sub