Capture line from web page and record entry into xml file.

OAC Technology
OAC Technology used Ask the Experts™
on
Hi,

I would like a vbscript to grab the "1-month rate" line on this page: http://www.liborated.com/current_libor_rates.asp and record the date and entry into an xml file.  I would like to be able to schedule this script to run daily so I can check the xml file and see all entries for this 1-month rate.

What's the easiest way to do this?

Thank you,
Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®

Commented:
to do that in vbscript that might be a nasty task.
Even if you do a console application with CLR it will still be a nasty task, but doing that in vbscript it is even worse.

steps i would do (using .c# not vbs)
1.) load the source with webrequest / response.
2.) parse the result hoping that the page itself does not change much, because afais there is no special id or stuff that can help to find the needed information easily.
3.) extract the data from the found line using regex
4.) create  /open an xml file and append lthe result items

handling xml with vb(s) is not that different from doing it with c#, but finding the infos you need can be tough though.

Commented:
interesting question.....listening.....
Commented:
huh ... got some kind of code.
I assume you have MSXML 6 installed and you can use WinHttp.

Just have a look at the result. Works fine for me as long as the website-host does not change the page.
If the messageboxes bother you just remove the wscript calls.

Download method is based on http://www.robvanderwoude.com/vbstech_internet_download.php

hope that helps :)

call DoWork

Sub DoWork
    Dim bDownload, retCol
    bDownload = Download("http://www.liborated.com/current_libor_rates.asp", "C:\temp\dl.txt")
    retCol = FindData("C:\temp\dl.txt")
    If (UBound(retCol) = 4) Then
        Call WriteXML("C:\temp\result.xml", retCol)
	else
		WScript.Echo "ERROR: Elements not found! - Check FindData-Function"
    End If
End Sub


Function WriteXML(xmlpath, values)
	WScript.Echo "write data..."
    Dim myFSO
    Set myFSO = CreateObject("Scripting.FileSystemObject")
    If (Not myFSO.FileExists(xmlpath)) Then
        Set myfile = myFSO.CreateTextFile(xmlpath, False)
        Call myfile.WriteLine("<?xml version=""1.0"" encoding=""UTF-8""?>")
        Call myfile.WriteLine("<DataSets>")
        Call myfile.WriteLine("<DataSet Date=""" & Date & """>")
        Call myfile.WriteLine("<Term>" & values(0) & "</Term>")
        Call myfile.WriteLine("<Rate>" & values(1) & "</Rate>")
        Call myfile.WriteLine("<UpDown>" & values(2) & "</UpDown>")
        Call myfile.WriteLine("<WeekHigh52>" & values(3) & "</WeekHigh52>")
        Call myfile.WriteLine("<WeekDown52>" & values(4) & "</WeekDown52>")
        Call myfile.WriteLine("</DataSet>")
        Call myfile.WriteLine("</DataSets>")
        myfile.Close
        Set myfile = Nothing
        Set myFSO = Nothing
        WriteXML = True
        Exit Function
    End If
    Set myFSO = Nothing

    Dim myXML, root, ds, cNode
    Set myXML = CreateObject("MSXML2.DOMDocument.6.0")
    
    myXML.async = False
    If (myXML.Load(xmlpath)) Then
        
        Set root = myXML.selectSingleNode("DataSets")
        If (Not root Is Nothing) Then
            
            Set ds = myXML.createElement("DataSet")
            Call ds.setAttribute("Date", CStr(Date))
            ds.appendChild myXML.createTextNode(vbCrLf)
                        
            Set cNode = myXML.createElement("Term")
            cNode.Text = values(0)
            Call ds.appendChild(cNode)
            ds.appendChild myXML.createTextNode(vbCrLf)
        
            Set cNode = myXML.createElement("Rate")
            cNode.Text = values(1)
            Call ds.appendChild(cNode)
            ds.appendChild myXML.createTextNode(vbCrLf)
            
            Set cNode = myXML.createElement("UpDown")
            cNode.Text = values(2)
            Call ds.appendChild(cNode)
            ds.appendChild myXML.createTextNode(vbCrLf)
            
            Set cNode = myXML.createElement("WeekHigh52")
            cNode.Text = values(3)
            Call ds.appendChild(cNode)
            ds.appendChild myXML.createTextNode(vbCrLf)
        
            Set cNode = myXML.createElement("WeekDown52")
            cNode.Text = values(4)
            Call ds.appendChild(cNode)
            ds.appendChild myXML.createTextNode(vbCrLf)
            
            root.appendChild myXML.createTextNode(vbCrLf)
            Call root.appendChild(ds)
            root.appendChild myXML.createTextNode(vbCrLf)
            Call myXML.save(xmlpath)
        End If
            Set myXML = Nothing
    End If
    WriteXML = False
	WScript.Echo "...done"
End Function

Function FindData(path)
    
	WScript.Echo "find data..."
    Dim myArray(4)
    Dim myFSO, content, myRegEx
    Set myFSO = CreateObject("Scripting.FileSystemObject")        
    
    If (myFSO.FileExists(path)) Then
        Set fs = myFSO.OpenTextFile(path, 1)
        
         Do Until fs.AtEndOfStream
        
            content = fs.ReadLine
            If (Trim(content) = "<td width=""60"" bordercolor=""dedede"" bgcolor=""dedede""><div align=""center""><strong>52-Week Low</strong></div></td>") Then
                fs.ReadLine
                fs.ReadLine
                
                set myRegEx = CreateObject("VBScript.RegExp")
                myRegEx.IgnoreCase = True
                myRegEx.Global = True
                myRegEx.Pattern = "<(.)+?>"
                
                myArray(0) = myRegEx.Replace(Trim(fs.ReadLine), "")
                myArray(1) = myRegEx.Replace(Trim(fs.ReadLine), "")
                myArray(2) = myRegEx.Replace(Trim(fs.ReadLine), "")
                myArray(3) = myRegEx.Replace(Trim(fs.ReadLine), "")
                myArray(4) = myRegEx.Replace(Trim(fs.ReadLine), "")
                Set myRegEx = Nothing
                Exit Do
            End If
        Loop
    End If
    
    fs.Close
    Set fs = Nothing
       
    Set myFSO = Nothing
    FindData = myArray
	WScript.Echo "done"
End Function

Function Download(myURL, myPath)
	WScript.Echo "downloading file..."
    Dim i, objFSO, objFile, objHTTP, strFile, strMsg
    
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    If objFSO.FolderExists(Left(myPath, InStrRev(myPath, "\") - 1)) Then
        strFile = myPath
    Else
        WScript.Echo "ERROR: Target folder not found"
        Download = False
        Exit Function
    End If

    Set objFile = objFSO.OpenTextFile(strFile, 2, True)
    Set objHTTP = CreateObject("WinHttp.WinHttpRequest.5.1")

    Call objHTTP.Open("GET", myURL, False)
    Call objHTTP.Send
    For i = 1 To LenB(objHTTP.ResponseBody)
        objFile.Write Chr(AscB(MidB(objHTTP.ResponseBody, i, 1)))
    Next
    Call objFile.Close
    Download = True
	WScript.Echo "...done"
End Function

Open in new window

OAC TechnologyProfessional Nerds

Author

Commented:
Thank you very much

Commented:
you are welcome :)

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial