Christmas is coming up, and millions of children around the world want to know: How cold is it really at the North Pole, where Santa Claus reportedly resides?
First off, where do we get the temperature from? The North Pole Environmental Observatory (NPEO) is operating floating bouys in the Arctic region and publishes temperature data on that page. The idea is to have a VBA macro that loads the page content and looks for temperature for a given buoy.
You can find the macro below. Here is a short description of the VBA code
- First, it creates a HTTP object. HTTP objects can be used to obtain content online, in this case the NPEO's web page. In fact, the whole page's HTML code will be downloaded and stored in a string that we can handle.
- The code then searches for the temperature information in that string. The NPEO publishes temperature data in Celsius; the macro also converts it to Fahrenheit, so that we have both. The conversion formula can be found on the Wikipedia page.
- A message box then shows the temperature to the user.
...and that's already all you need. The tricky part is that the code relies on having the buoys name/code as a hard value. For a long time, as still included in the VBA code, the buoy closest to the North Pole was EUMETNET ICEB Buoy 409520. Later, one had to go for IABP PAWS Buoy 975420. Check the page and adjust the code accordingly.
Happy Holidays!
Sub GetNorthPoleWeather()
' Retrieves the temperature of the EUMETNET ICEB Buoy 409520.
' This buoy is floating close to, but not necessarily directly at the actual North Pole.
' Data is retrieved from http://psc.apl.washington.edu/northpole/
Dim strURL As String, strHTTPResponse As String, strBufC As String, strBufF As String
Dim iPos1 As Integer, iPos2 As Integer, iLength As Integer
' Create the HTTP object and send the request so we can retrieve the web page with the information we need.
Set objHTTP = CreateObject("MSXML2.XMLHTTP")
strURL = "http://psc.apl.washington.edu/northpole/"
objHTTP.Open "GET", strURL, False
objHTTP.Send
strHTTPResponse = objHTTP.responseText ' store the HTTP response
' Use Mid and InStr to only look at the relevant part of the response, i.e. after the text "EUMETNET ICEB Buoy 409520".
' (A more elegant, but more complex way to solve this would be regular expressions. We will go for the simple way.)
iPos1 = InStr(1, strHTTPResponse, "EUMETNET ICEB Buoy 409520")
strBufC = Mid(strHTTPResponse, iPos1)
' In the remaining string, the temperature value is between "°C " on the right and the first ";" to the left of that.
' We will set iPos1 and iPos2 to cover that section.
iPos2 = InStr(1, strBufC, "°C ")
iPos1 = InStrRev(strBufC, ";", iPos2) + 1
strBufC = Mid(strBufC, iPos1, (iPos2 - iPos1)) ' strBuf is now only the temperature value
' Finally, convert the Celsius value to Fahrenheit, so we can show both
strBufF = Format(CelsiusToFahrenheit(CDbl(strBufC)), "#.0")
' Set the text of the shape to show the current temperature
Sheets("Calendar").Shapes("tb_Temperature").TextFrame.Characters.Text = strBufC & " °C" & vbNewLine & strBufF & " °F"
End Sub
Sub ShowWeatherInfo()
frmNorthPole.Show
End Sub
Private Function CelsiusToFahrenheit(dCelsius As Double) As Double
CelsiusToFahrenheit = (dCelsius * 1.8) + 32
End Function
