'This file pulls XML data from a source, extracts info and writes it to a file.
'METAR example - Vero Beach Airport (KVRB)
strStationID = "KVRB"
'**** If you are using a METAR weather station instead of Weather Underground set METAR = True
'**** METAR weather stations are aviation stations and a 4 characters long
'METAR = False
METAR = True
'choice of values:
'temp_c sample: 10.1
'strValuetoExtract = "/current_observation/temp_c"
'temp_f sample: 50.2
'strValuetoExtract = "/current_observation/temp_f"
'relative_humidity sample: 73
'strValuetoExtract = "/current_observation/relative_humidity"
'wind_string sample: calm
'strValuetoExtract = "/current_observation/wind_string"
'temperature_string sample: 50.2 F (10.1 C)
strValuetoExtract = "/current_observation/temperature_string"
'wind_mph sample: 0.0
'strValuetoExtract = "/current_observation/wind_mph"
'precip_today_in sample: 0.0
'strValuetoExtract = "/current_observation/precip_today_in"
'precip_today_metic sample: 0.0 cm
'strValuetoExtract = "/current_observation/precip_today_metric"
'windchill_string sample: don't know
'strValuetoExtract = "/current_observation/windchill_string"
'windchill_f sample: don't know
'strValuetoExtract = "/current_observation/windchill_f"
'windchill_c sample: don't know
'strValuetoExtract = "/current_observation/windchill_c"
strFolderName = "c:\"
strFilename = "temperature.txt"
If METAR then
URL = "http://w1.weather.gov/xml/current_obs/" & strStationID & ".xml"
Else
URL = "http://api.wunderground.com/weatherstation/WXCurrentObXML.asp?ID=" & strStationID
End If
'You probably do not want to mess with the stuff below this line
Set WshShell = WScript.CreateObject("WScript.Shell")
Set http = CreateObject("Microsoft.XmlHttp")
http.open "GET", URL , FALSE
http.send ""
'WScript.Echo http.responseText
Set objXmlDoc = CreateObject("MSXML2.DomDocument")
objXmlDoc.async = True
objXmlDoc.loadXML http.responseText
If (objXmlDoc.parseError.errorCode <> 0) Then
Dim myErr
Set myErr = objXmlDoc.parseError
MsgBox("You have error " & myErr.reason)
Else
'MsgBox objXmlDoc.xml
End If
set objNode = objXmlDoc.selectSingleNode(strValuetoExtract)
set myFSO=CreateObject("Scripting.FileSystemObject")
set WriteStuff = myFSO.CreateTextFile(strFoldername + strFilename,true)
WriteStuff.WriteLine(objNode.Text)
WriteStuff.Close
Const ForReading = 1
Const ForWriting = 2
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile("C:\temperature.txt", ForReading)
strFile = objFile.ReadAll
objFile.Close
intLength = Len(strFile)
strEnd = Right(strFile, 2)
If strEnd = vbCrLf Then
strFile = Left(strFile, intLength - 2)
Set objFile = objFSO.OpenTextFile("C:\temperature.txt", ForWriting)
objFile.Write strFile
objFile.Close
End If
set WriteStuff = Nothing
Set myFSO = Nothing
set WshShell = nothing
set http = nothing
set objXmlDoc = Nothing
set objNode = Nothing