"Karen Middleton" <karenmiddleol (AT) yahoo (DOT) com> wrote
Quote:
I want to access a web site like www.oanda.com and on this web site
there is a currency exchange rates table I want to parse this into a
VB array to be later used within for currency conversion.
Can somebody please clarify I am able to get the web page into a VB
script and later do not know how to proceed with parsing for this
table and taking this table into a VB Script array.
Your help is highly appreciated.
Thanks
Karen
Dim xml,objCDO
Set xml = CreateObject("Microsoft.XMLHTTP")
xml.Open "GET", "http://www.oanda.com", False
xml.Send
msgbox xml.responsetext |
Will this help?; watch for word-wrap.
'***
'* Currency Rates from OANDA.com
'***
Option Explicit
'*
'* Declare Constants
'*
Const cVBS = "oanda.vbs"
Const cURL = "http://www.oanda.com/"
Const cTD0 = "</div>"
Const cTD1 = " <div align=""center"" class=""TblHdrRt"">"
Const cTD2 = "<div align=""center"" class=""TblRt"">"
'*
'* Declare Variables
'*
Dim arrCUR(5,5)
arrCUR(0,0) = ""
arrCUR(0,1) = "USD"
arrCUR(0,2) = "GBP"
arrCUR(0,3) = "EUR"
arrCUR(0,4) = "JPY"
arrCUR(0,5) = "CHF"
arrCUR(1,0) = "USD"
arrCUR(2,0) = "GBP"
arrCUR(3,0) = "EUR"
arrCUR(4,0) = "JPY"
arrCUR(5,0) = "CHF"
Dim intCUR
Dim strCUR
Dim intFOR
Dim strRAT
Dim intTD0
Dim intTD1
Dim intTD2
Dim strXML
'*
'* Declare Objects
'*
Dim objXML
'*
'* Process URL
'*
Call OpenURL()
'*
Set objXML = CreateObject("Microsoft.XMLHTTP")
objXML.Open "GET", cURL, False
objXML.Send
If Err.Number <> 0 Or objXML.Status <> 200 Then
MsgBox "XMLHTTP Failed!",vbExclamation,cVBS
WScript.Quit
End If
strXML = objXML.ResponseText
Set objXML = Nothing
'*
'* Build Array
'*
For intCUR = 1 To UBound(arrCUR,1)
intTD1 = InStr(strXML,cTD1)
If intTD1 = 0 Then WScript.Quit
strXML = Mid(strXML,intTD1+Len(cTD1))
intTD0 = InStr(strXML,cTD0)
strCUR = Left(strXML,intTD0-1)
If strCUR = arrCUR(intCUR,0) Then
For intFOR = 1 To UBound(arrCUR,2)
intTD2 = InStr(strXML,cTD2)
If intTD2 = 0 Then WScript.Quit
strXML = Mid(strXML,intTD2+Len(cTD2))
intTD0 = InStr(strXML,cTD0)
arrCUR(intCUR,intFOR) = Left(strXML,intTD0-1)
Next
End If
Next
'*
'* Display Array
'*
For intCUR = 0 To UBound(arrCUR,1)
If intCUR > 0 Then strCUR = strCUR & vbCrLf
For intFOR = 0 To UBound(arrCUR,2)
If intFOR > 0 Then strCUR = strCUR & vbTab
strCUR = strCUR & arrCUR(intCUR,intFOR)
Next
Next
MsgBox strCUR,vbInformation,cVBS
'*
'* Lookup Currency Rates
'*
MsgBox "USD:EUR = " & Lookup("USD","EUR"),vbInformation,cVBS
MsgBox "GBP:USD = " & Lookup("GBP","USD"),vbInformation,cVBS
MsgBox "EUR:JPY = " & Lookup("EUR","JPY"),vbInformation,cVBS
Function Lookup(Currency1,Currency2)
Lookup = ""
'*
Dim intCOL
intCOL = 0
Dim intROW
intROW = 0
Dim intZRO
intZRO = 2
'*
For intCUR = 1 To UBound(arrCUR,1)
If arrCUR(intCUR,0) = Currency1 Then
intROW = intCUR
intZRO = intZRO - 1
End If
If arrCUR(intCUR,0) = Currency2 Then
intCOL = intCUR
intZRO = intZRO - 1
End If
Next
If intZRO = 0 Then Lookup = arrCUR(intROW,intCOL)
End Function
Sub OpenURL()
Dim strIEA
strIEA = "View " & cURL & "?"
Dim objIEA
Set objIEA = CreateObject("InternetExplorer.Application")
objIEA.Navigate cURL
While objIEA.ReadyState <> 4
Wend
If MsgBox(strIEA,vbQuestion+vbYesNo,cVBS) = vbYes Then
objIEA.Visible = True
End If
Set objIEA = Nothing
End Sub
Of course this depends on their Web site layout remaining constant...