State Weather Advisories available by RSS

weather

In Exploring the NOAA API I posted code for consuming the NOAA RSS feed for Atlantic storms.

I also posted weather-finding functions using the Geonames API, the WebserviceX.NET API and even a cheap formula for opening weather.com.

Now let's explore even more weather-related functions (I'm sure you're as excited as I am!). This one is an API from weather.gov that provides state-by-state weather advisories which you can use in your VBA programs.

I noticed that in addition to providing a RSS feed, the feed URL itself only differs by the state abbreviation. So all we need to do is prompt for the state abbreviation and we can return any weather advisories in any state! And if you check weather.gov for all the state abbreviations, you can also look at weather for other U.S. territories and provinces.

The GetStateAdvisories Function

The following function takes a state abbreviation and returns any weather advisories issued by weather.gov for that state. Queries are cached, so the second parameter must be True to requery the API.

Function GetStateAdvisories(state As String, _
    Optional forceRequery As Boolean = False) As String()
' see http://www.weather.gov/alerts-beta/ for list of states/provinces
Dim xml As Object ' MSXML2.XMLHTTP
Dim result As String
Dim tempFolder As String
Dim tempFile As String
Dim tempString() As String
Dim xmlDoc As Object ' MSXML2.DOMDocument
Dim xmlDocRoot As Object ' MSXML2.IXMLDOMNode
Dim feed As Object ' MSXML2.IXMLDOMNodeList
Dim i As Long, j As Long
Dim numberOfEntries As Long
Dim entry As Object ' MSXML2.IXMLDOMNodeList

Const XML_FILE_EXTENSION As String = &quot;.xml&quot;

  tempFolder = environ(&quot;temp&quot;)

  Set xml = CreateObject(&quot;MSXML2.XMLHTTP.6.0&quot;)

  tempFile = tempFolder &amp; Application.PathSeparator &amp; &quot;stateweather_&quot; &amp; _
    state &amp; XML_FILE_EXTENSION

  ' query website if cache is empty or we are forced to
  If (Len(Dir(tempFile)) = 0 Or forceRequery) Then

    With xml
      .Open &quot;GET&quot;, &quot;http://www.weather.gov/alerts-beta/&quot; &amp; _
    LCase$(state) &amp; &quot;.php?x=0&quot;, False
      .send
    End With

    result = ConvertAccent(xml.responseText)

    ' create XML file from result
    Call CreateXMLFile(tempFile, result)

  End If

  Set xmlDoc = CreateObject(&quot;MSXML2.DOMDocument&quot;)

  With xmlDoc
    .async = False
    .validateOnParse = False
    .Load tempFile
  End With

  ' check that the XML doc loaded
  If LoadError(xmlDoc) Then
    Exit Function
  End If

  ' get root node
  Set xmlDocRoot = GetRootNode(xmlDoc)
  ' get first level nodes
  Set feed = GetChildNodes(xmlDocRoot)

  ' count number of entries to figure out
  ' how many rows in the array
  For i = 1 To feed.Length
    If feed.item(i - 1).nodeName = &quot;entry&quot; Then
      numberOfEntries = numberOfEntries + 1
    End If
  Next i

  ' resize array
  ' there are four nodes of information per entry
  ReDim tempString(1 To numberOfEntries, 1 To 4)

  ' start grabbing!
  For i = 1 To feed.Length
    If feed.item(i - 1).nodeName = &quot;entry&quot; Then
      ' it's an entry
      Set entry = feed.item(i - 1).childNodes

      ' check for no watches
      If InStr(entry.item(3).nodeTypedValue, &quot;There are no active watches&quot;) &gt; 0 Then
        tempString(1, 1) = entry.item(1).nodeTypedValue
        tempString(1, 2) = entry.item(3).nodeTypedValue
        tempString(1, 3) = entry.item(4).Attributes.getNamedItem(&quot;href&quot;).nodeTypedValue
        tempString(1, 4) = entry.item(5).nodeTypedValue
      Else
        For j = 1 To numberOfEntries
          tempString(j, 1) = entry.item(1).nodeTypedValue
          tempString(j, 2) = entry.item(4).nodeTypedValue
          tempString(j, 3) = entry.item(5).Attributes.getNamedItem(&quot;href&quot;).nodeTypedValue
          tempString(j, 4) = entry.item(6).nodeTypedValue
        Next j
      End If
    End If
  Next i

  GetStateAdvisories = tempString

End Function

Because there is a series of irrelevant nodes that appear before the weather entries, we need to loop through the nodes to find out how many entries there are. After sizing the temporary array we'll use to hold the entry information, we loop again through the nodes.

If there are no active weather advisories, there will be one node and we don't really need to loop. Otherwise we loop through each entry and grab the weather advisory along with the URL from weather.gov.

Sample usage

This procedure will return and iterate through any available weather advisories for New York State.

Sub TestGetAdvisories()

Dim results() As String
Dim i As Long, j As Long

  results = GetStateAdvisories(&quot;NY&quot;)

  For i = LBound(results) To UBound(results)
    For j = LBound(results, 2) To UBound(results, 2)
      Debug.Print results(i, j)
    Next j
  Next i

End Sub