【VBA】调用高德天气API，获取天气信息到 excel表中

`

'调用高德天气API，获取天气信息到 excel表中
Sub GetWeatherFromGaode()
Dim http As Object
Dim url As String
Dim apiKey As String
Dim cityCode As String
Dim response As String
Dim json As Object
Dim weatherInfo As String
Dim temperature As String
Dim humidity As String
Dim windDirection As String
Dim windPower As String
Dim province As String
Dim city As String
Dim reporttime As String
Dim ws1 As Worksheet
Set ws1 = ThisWorkbook.Worksheets("天气信息") '修改为实际的工作表名称
Dim lastRow1 As Long
lastRow1 = ws1.Cells(Rows.Count, 1).End(xlUp).Row + 1
Dim currentDateTime As Date
currentDateTime = Now

' 格式化日期为 "yyyy-mm-dd" 格式
Dim formattedDate As String
formattedDate = Format(currentDateTime, "yyyy-mm-dd")

Dim formattedTime As String
formattedTime = Format(currentDateTime, "hh:mm:ss")

 ' 格式化日期和时间为 "yyyy-mm-dd hh:mm:ss" 格式
Dim formattedDateTime As String
formattedDateTime = Format(currentDateTime, "yyyy-mm-dd hh:mm:ss")

 Dim currentDate As Date
currentDate = Date
Dim weekdayNumber As Integer
weekdayNumber = Weekday(currentDate)
' 调用自定义函数将星期数字转换为中文星期
Dim weekdayChinese As String
weekdayChinese = WeekdayToChinese(weekdayNumber)


' 设置API Key和城市编码
apiKey = ""  ' 替换为你的高德API Key
cityCode = "110101"     ' 替换为你想查询的城市编码（例如：110101 是北京）

' 构建API请求URL
url = "https://restapi.amap.com/v3/weather/weatherInfo?city=" & cityCode & "&key=" & apiKey

' 创建HTTP请求对象
Set http = CreateObject("MSXML2.XMLHTTP")

' 发送GET请求
http.Open "GET", url, False
http.Send

' 获取响应
response = http.responseText

' 解析JSON响应（需要导入JsonConverter.bas模块）
Set json = JsonConverter.ParseJson(response)

' 提取天气信息
If json("status") = "1" Then
    weatherInfo = json("lives")(1)("weather")
    temperature = json("lives")(1)("temperature")
    humidity = json("lives")(1)("humidity")
    windDirection = json("lives")(1)("winddirection")
    windPower = json("lives")(1)("windpower")
    province = json("lives")(1)("province")
    city = json("lives")(1)("city")
    reporttime = json("lives")(1)("reporttime")
    
    
      If ws1.Cells(lastRow1, 1).Value = "" Then
                ws1.Cells(lastRow1, 1).Value = lastRow1 - 1
                 ws1.Cells(lastRow1, 2).Value = formattedDateTime
                 ws1.Cells(lastRow1, 3).Value = weekdayChinese
                  ws1.Cells(lastRow1, 4).Value = province
                   ws1.Cells(lastRow1, 5).Value = city
                    ws1.Cells(lastRow1, 6).Value = weatherInfo
                     ws1.Cells(lastRow1, 7).Value = temperature
                      ws1.Cells(lastRow1, 8).Value = humidity
                       ws1.Cells(lastRow1, 9).Value = windDirection
                     ws1.Cells(lastRow1, 10).Value = windPower
                      ws1.Cells(lastRow1, 11).Value = reporttime
            End If

    
    ' 输出天气信息
   '  MsgBox "城市: " & json("lives")(1)("city") & vbCrLf & _
           "天气: " & weatherInfo & vbCrLf & _
           "温度: " & temperature & "°C" & vbCrLf & _
           "湿度: " & humidity & "%" & vbCrLf & _
           "风向: " & windDirection & vbCrLf & _
           "风力: " & windPower
Else
    MsgBox "获取天气数据失败，请检查API Key或城市编码。"
End If

' 清理对象
Set http = Nothing
Set json = Nothing

End Sub

Function WeekdayToChinese(weekdayNumber As Integer) As String
Select Case weekdayNumber
Case 1
WeekdayToChinese = "日"
Case 2
WeekdayToChinese = "一"
Case 3
WeekdayToChinese = "二"
Case 4
WeekdayToChinese = "三"
Case 5
WeekdayToChinese = "四"
Case 6
WeekdayToChinese = "五"
Case 7
WeekdayToChinese = "六"
Case Else
WeekdayToChinese = "无效"
End Select
End Function

`

※注意 需要提前导入JsonConverter.bas模块