VBA获取网页API提供的JSON数据

zoneq6 · 发表于 2014-11-4 22:56

本帖最后由 zoneq6 于 2014-11-4 22:56 编辑

求大神帮帮忙！小弟想通过Excel的VBA从下面的链接中获取JSON数据的String格式，还请大神给个实例或指点迷津……小弟拜谢了！！！
http://www.pm25.in/api/querys/pm2_5.json?city=珠海&token=5j1znBVAsnSf5xQyNQyq

onlycxb · 发表于 2014-11-5 08:12

'示意代码
Sub t()
Dim St As String, i As Integer
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", "http://www.pm25.in/api/querys/pm2_5.json?city=%E7%8F%A0%E6%B5%B7&token=5j1znBVAsnSf5xQyNQyq", False
.send
St = .responseText
End With
With CreateObject("MSScriptControl.ScriptControl")
.Language = "javascript"
.AddCode ("Dy=" & St)
For i = 0 To .Eval("Dy.length") - 1
Cells(i + 1, 1) = .Eval("Dy[" & i & "].aqi")
Cells(i + 1, 2) = .Eval("Dy[" & i & "].area")
Cells(i + 1, 3) = .Eval("Dy[" & i & "].pm2_5_24h")
Cells(i + 1, 3) = .Eval("Dy[" & i & "].position_name")
Cells(i + 1, 4) = .Eval("Dy[" & i & "].primary_pollutant")
'其他省略
Next i
End With
End Sub

复制代码

ghostjiao · 发表于 2014-11-5 08:44

本帖最后由 ghostjiao 于 2014-11-5 08:47 编辑

Sub json()
Dim objXML, objJS, objS, tt$, p, arr(1 To 100, 1 To 9), n%, j%, ar
Set objJS = CreateObject("MSScriptControl.ScriptControl")
Set objXML = CreateObject("MSXML2.XMLHTTP")
ar = Array("aqi", "area", "pm2_5", "pm2_5_24h", "position_name", "primary_pollutant", "quality", "station_code", "time_point")
With objXML
.Open "GET", "http://www.pm25.in/api/querys/pm2_5.json?city=%E7%8F%A0%E6%B5%B7&token=5j1znBVAsnSf5xQyNQyq", False
.send
tt = "var mydata=" & .responsetext
End With
With objJS
.Language = "javascript"
.addcode tt
Set objS = .codeobject
For Each p In CallByName(objS, "mydata", VbGet)
n = n + 1
For j = 1 To 9
arr(n, j) = CallByName(p, ar(j - 1), VbGet)
Next
Next
End With
Range("a1").Resize(1, 9) = ar
Range("a2").Resize(n, 9) = arr
End Sub

复制代码

zoneq6 · 发表于 2014-11-5 14:16

onlycxb 发表于 2014-11-5 08:12

感谢两位大神的帮助，在此拜谢了……

zoneq6 · 发表于 2014-11-5 14:30

ghostjiao 发表于 2014-11-5 08:44

感谢两位大神的帮助，在此拜谢了……

浮华、缠绕指尖 · 发表于 2014-11-5 17:56

本帖最后由浮华、缠绕指尖于 2014-11-5 18:11 编辑

我也来凑个热闹

Sub test()
Set xml = CreateObject("WinHttp.WinHttpRequest.5.1")
With xml
.Open "GET", "http://www.pm25.in/api/querys/pm2_5.json?city=%E7%8F%A0%E6%B5%B7&token=5j1znBVAsnSf5xQyNQyq", False
.Send
If InStr(.responsetext, "用完") = 0 Then strJS = "var a=" & .responsetext & ";var s='';for(x in a){for(y in a[x]){s+=a[x][y]+'\t';}s+='\r';}"
End With
With CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
.SetText 执行(strJS)
.PutInClipboard
End With
With ActiveSheet
.[A2].Select
.Paste
End With
End Sub
Function 执行(ByVal strJS As String)
With CreateObject("MSScriptControl.ScriptControl")
.Language = "javascript"
执行 = .Eval(strJS)
End With
End Function

复制代码

xiaoying691 · 发表于 2017-1-12 11:29

ghostjiao 发表于 2014-11-5 08:44

您好为什么我到这句提示错误
For Each p In CallByName(objS, "mydata", VbGet)

xiaoying691 · 发表于 2017-1-12 11:30

zoneq6 发表于 2014-11-5 14:16
感谢两位大神的帮助，在此拜谢了……

您好我也遇到vba取json数据的问题请问解决了么？？
我都研究很久了！实在感谢

xiaoying691 · 发表于 2017-1-12 12:44

ghostjiao 发表于 2014-11-5 08:44

For Each p In CallByName(objS, "mydata", VbGet) 这句报错，提示不支持该属性或方法

未忘初心 · 发表于 2017-1-12 12:53

0.0 2014年的帖子你过了3年再来回答可能他们都忘记了

		自动登录	找回密码
密码			免费注册

[求助] VBA获取网页API提供的JSON数据