怎么用VBA进行历史天气查询

1042271867

各位老师:我附件中代码只能实现对当月的历史天气查询（网址：  http://tianqi.2345.com/wea_history/60308.htm ），此代码也是从这个网上找到的。现在我想实现查询本年度的历史天气（1月到本月的），怎么用VBA进行查询呢，谢谢您！

WANT-T

看着代码咋这么熟悉呢？从老山羊头那嫖的嘛？

txh30603866

Sub Get_Weather() '天气温度获取
    Dim xmlHttp As Object '创建对象
    Set xmlHttp = CreateObject("MSXML2.XMLHTTP")
    xmlHttp.Open "GET", "https://www.weaoo.com/nantong-haimenshi-417.html", False '发送请求
    xmlHttp.send
    Do While xmlHttp.ReadyState <> 4 '等待响应
    DoEvents
    Loop
    Dim Myhtml As String
    Myhtml = xmlHttp.responseText '得到请求数据
    Dim weather As String
    weather = Replace(Split(Split(Myhtml, "<i class=""wi wi-night-cloudy""> </i>")(1), "</span>")(0), Chr(10), "")
    Weathers = Split(Replace(weather, " ", ""), "/")
    MsgBox ("今日温度：" & Weathers(0))
End Sub

Sub Orient_Weather() '天气温度获取
    OrientDate = "2023/5/1"
    HtmlDate = Format(OrientDate, "YYYYMM")
    StrDate = Format(OrientDate, "YYYY-MM-DD")
    Dim xmlHttp As Object '创建对象
    Set xmlHttp = CreateObject("MSXML2.XMLHTTP")
    xmlHttp.Open "GET", "https://lishi.tianqi.com/nantong/" & HtmlDate & ".html", False '发送请求
    xmlHttp.send
    Do While xmlHttp.ReadyState <> 4 '等待响应
    DoEvents
    Loop
    Dim Myhtml As String
    Myhtml = xmlHttp.responseText '得到请求数据
    Dim weather As String
    weather = Split(Split(Myhtml, "<div class=""th200"">" & StrDate)(1), "</li>")(0)
    Weathers = Split(weather, "<div class=""th140"">")
    For i = 0 To UBound(Weathers)
        Weathers(i) = Split(Weathers(i), "</div>")(0)
    Next i
    Weathers(0) = Replace(Weathers(0), " ", "") '星期去除前后空格
    Debug.Print "当前日期当时星期：" & Weathers(0)
    Debug.Print "当前日期最高温度：" & Weathers(1)
    Debug.Print "当前日期最低温度：" & Weathers(2)
    Debug.Print "当前日期天气信息：" & Weathers(3)
    Debug.Print "当前日期风向风级：" & Weathers(4)
End Sub
自行测试，可以指定日期获得当前天气

x-xx-xx

这个VBA不太好弄的样子,我的话就模拟手动打开浏览器操作吧

x-xx-xx

20230809_120244.rar (306.25 KB, 下载次数: 121)

2023-8-9 12:02 上传

点击文件名下载附件

perfect131

http://tianqi.2345.com/Pc/GetHistory?areaInfo[areaId]=60308&areaInfo[areaType]=2&date[year]=2023&date[month]=1
循环即可 可以搞

1042271867

谢谢你呀，我不知怎么具体操作呢

perfect131

可以搞




批量

1042271867

perfect131 发表于 2023-8-9 14:10
可以搞

能将代码贴上来吗，谢谢啦

perfect131

1042271867 发表于 2023-8-9 14:32
能将代码贴上来吗，谢谢啦

当然可以，小钱接您大事,有偿联系