Dim D As Date
Dim XMLH As Object
XMLH = CreateObject("Microsoft.XMLHTTP")
Dim drs As List(Of DataRow) = DataTables("表A").Select("代码 is not null")
For Each dr As DataRow In drs
XMLH.open("GET", "http://www.weather.com.cn/data/sk/" & dr("代码") & ".html", True) '获得实时信息
XMLH.send(Nothing)
Do While XMLH.readyState <> 4
Application.DoEvents
Loop
'把数据json数据转化成对象
Dim json As String = XMLH.responseText
Dim ScriptControl As Object, data As Object, JscriptCode As String
JscriptCode = "function toObject(json) {eval(""var o=""+json);return o;}"
ScriptControl = CreateObject("MSScriptControl.ScriptControl")
With ScriptControl
.Language = "Javascript"
.Timeout = -1
.AddCode(JscriptCode)
data = .Run("toObject", json)
End With
dr("城市") = data.weatherinfo.city
dr("实时_气温") = data.weatherinfo.temp
dr("实时_风向") = data.weatherinfo.WD
dr("实时_风速") = data.weatherinfo.WS
dr("实时_更新时间")=data.weatherinfo.time
dr("实时_湿度")=data.weatherinfo.SD
'----------------------------------------------------------------------------------
XMLH.open("GET", "http://m.weather.com.cn/atad/" & dr("代码") & ".html", True) '获得预报信息
XMLH.send(Nothing)
Do While XMLH.readyState <> 4
Application.DoEvents
Loop
'把数据json数据转化成对象
json = XMLH.responseText
JscriptCode = "function toObject(json) {eval(""var o=""+json);return o;}"
ScriptControl = CreateObject("MSScriptControl.ScriptControl")
With ScriptControl
.Language = "Javascript"
.Timeout = -1
.AddCode(JscriptCode)
data = .Run("toObject", json)
End With
dr("今天_气温") = data.weatherinfo.temp1
dr("今天_天气") = data.weatherinfo.weather1
dr("今天_风速") = data.weatherinfo.wind1
dr("今天_图标") = data.weatherinfo.img1
dr("今天_图标2") = data.weatherinfo.img2
dr("明天_气温") = data.weatherinfo.temp2
dr("明天_天气") = data.weatherinfo.weather2
dr("明天_风速") = data.weatherinfo.wind2
dr("明天_图标") = data.weatherinfo.img3
dr("明天_图标2") = data.weatherinfo.img4
dr("后天_气温") = data.weatherinfo.temp3
dr("后天_天气") = data.weatherinfo.weather3
dr("后天_风速") = data.weatherinfo.wind3
dr("后天_图标") = data.weatherinfo.img5
dr("后天_图标2") = data.weatherinfo.img6
dr("第4天_气温") = data.weatherinfo.temp4
dr("第4天_天气") = data.weatherinfo.weather4
dr("第4天_风速") = data.weatherinfo.wind4
dr("第4天_图标") = data.weatherinfo.img7
dr("第4天_图标2") = data.weatherinfo.img8
dr("第5天_气温") = data.weatherinfo.temp5
dr("第5天_天气") = data.weatherinfo.weather5
dr("第5天_风速") = data.weatherinfo.wind5
dr("第5天_图标") = data.weatherinfo.img9
dr("第5天_图标2") = data.weatherinfo.img10
dr("第6天_气温") = data.weatherinfo.temp6
dr("第6天_天气") = data.weatherinfo.weather6
dr("第6天_风速") = data.weatherinfo.wind6
dr("第6天_图标") = data.weatherinfo.img11
dr("第6天_图标2") = data.weatherinfo.img12
dr("更新日期") = data.weatherinfo.date_y
dr("星期") = data.weatherinfo.week
dr("今天_穿衣指数") = data.weatherinfo.index_d
dr("今天_紫外线") = data.weatherinfo.index_uv
dr("今天_洗车指数") = data.weatherinfo.index_xc
dr("今天_旅游指数") = data.weatherinfo.index_tr
dr("今天_空气舒适度") = data.weatherinfo.index_co
dr("今天_晨练指数") = data.weatherinfo.index_cl
dr("今天_晾晒指数") = data.weatherinfo.index_ls
dr("今天_过敏指数") = data.weatherinfo.index_ag
D=dr("更新日期")
Next
With DataTables("表A")
.DataCols("第4天_气温").Caption =D.AddDays(3) & "_气温"
.DataCols("第4天_天气").Caption =D.AddDays(3) & "_天气"
.DataCols("第4天_图标").Caption =D.AddDays(3) & "_图标"
.DataCols("第4天_图标2").Caption =D.AddDays(3) & "_图标2"
.DataCols("第4天_风速").Caption =D.AddDays(3) & "_风速"
.DataCols("第5天_气温").Caption =D.AddDays(4) & "_气温"
.DataCols("第5天_天气").Caption =D.AddDays(4) & "_天气"
.DataCols("第5天_图标").Caption =D.AddDays(4) & "_图标"
.DataCols("第5天_图标2").Caption =D.AddDays(4) & "_图标2"
.DataCols("第5天_风速").Caption =D.AddDays(4) & "_风速"
.DataCols("第6天_气温").Caption =D.AddDays(5) & "_气温"
.DataCols("第6天_天气").Caption =D.AddDays(5) & "_天气"
.DataCols("第6天_图标").Caption =D.AddDays(5) & "_图标"
.DataCols("第6天_图标2").Caption =D.AddDays(5) & "_图标2"
.DataCols("第6天_风速").Caption =D.AddDays(5) & "_风速"
.BuildHeader()
End With
Dim btn As WinForm.Button =e. Form.Controls("Button2")
btn.PerformClick()