VBA openweathermap XML检索

时间:2014-06-25 13:44:46

标签: xml vba excel-vba openweathermap excel

我有一个电子表格,其中有一个城市,状态在col A.我想从当天到B列获得3天的沉降类型/值。我开始使用openweathermap API,我发现我缺乏经验XML正在扼杀我。以下是我如何开始,我还没有进一步发展。我曾经尝试过使用节点和元素的任何尝试都没有解决。任何帮助将不胜感激。

这是一个示例XML的链接 http://api.openweathermap.org/data/2.5/forecast/daily?q=Boston+MA&mode=xml&units=metric&cnt=7

Option Explicit

Function CityForecast(City As String) As String
Dim StartingURL As String
Dim SecondaryURL As String
Dim FinalURL As String
Dim CorrectedCity As String
Dim objXML As Object
Dim objDOM As MSXML2.DOMDocument60

CorrectedCity = Replace(City, " ", "+")
CorrectedCity = Replace(City, ",", "+")

StartingURL = "http://api.openweathermap.org/data/2.5/forecast/daily?q="
SecondaryURL = "&mode=xml&units=metric&cnt=7"
FinalURL = StartingURL + CorrectedCity + SecondaryURL
Debug.Print FinalURL

Set objXML = CreateObject("MSXML2.XMLHTTP")
Set objDOM = New MSXML2.DOMDocument60

With objXML
    .Open "GET", FinalURL, False
    .setRequestHeader "Content-Type", "application/x-www-form-URLEncoded"
    .send
    objDOM.LoadXML .responseText
End With


End Function

Function CorrectedDate(WxDate As String) As String
Dim yr As Integer
Dim dy As Integer
Dim mnth As Integer

yr = Left(WxDate, 4)
mnth = Right(Left(WxDate, 7), 2)
dy = Right(WxDate, 2)

CorrectedDate = mnth & "/" & dy & "/" & yr
End Function

1 个答案:

答案 0 :(得分:0)

尝试这样的事情。我使用DOMDocument而不是DOMDocument60,这给我带来了错误。您可能不需要更改该变量,但我确实如此。

此功能也被修改为接受变量预测daysOut。因此,如果您想要从今天(包括今天)开始第三天的预测,请执行以下操作:

=CityForecast("Boston, MA", 3)

以下是代码:

Option Explicit

    Function CityForecast(City As String, daysOut As Integer) As String
    Dim StartingURL As String
    Dim SecondaryURL As String
    Dim FinalURL As String
    Dim CorrectedCity As String
    Dim objXML As Object
    Dim objDOM As MSXML2.DOMDocument  '### Changed
    'new variables I added:
    Dim precip As IXMLDOMNode


    CorrectedCity = Replace(City, " ", "+")
    CorrectedCity = Replace(City, ",", "+")

    StartingURL = "http://api.openweathermap.org/data/2.5/forecast/daily?q="
    SecondaryURL = "&mode=xml&units=metric&cnt=7"
    FinalURL = StartingURL + CorrectedCity + SecondaryURL
    Debug.Print FinalURL

    Set objXML = CreateObject("MSXML2.XMLHTTP")
    Set objDOM = CreateObject("MSXML2.DOMDocument")   '### Changed

    With objXML
        .Open "GET", FinalURL, False
        .setRequestHeader "Content-Type", "application/x-www-form-URLEncoded"
        .send
        objDOM.LoadXML .responseText
    End With

    'Use xpath to get the appropriate precipitation detail
    Set precip = objDOM.SelectSingleNode("/weatherdata/forecast/time[" & daysOut & "]/precipitation")


    If precip Is Nothing Then 
    ' in the event that the node doesn't exist
        CityForecast = "n/a" 
    Else
    ' otherwise, return the forecast attribute (0):
        If precip.Attributes.Length = 0 then
            CityForecast = 0
        Else
            CityForecast = precip.Attributes(0).nodeTypedValue
        End IF
    End If

    Set objXML = Nothing
    Set objDOM = Nothing

    End Function