Rob van der Woude's Scripting Pages

VBScript Scripting Techniques > Network > Yahoo Exchange Rates

Query Yahoo for Currency Exchange Rates

  1. WinHTTP (Function)
  2. WinHTTP (Class)

 

WinHTTP (Class)
VBScript Code:
Option Explicit

Dim objYFX

Set objYFX = New YFX

' Show class information
WScript.Echo "Class ""YahooFX"", Version " & objYFX.Version
WScript.Echo objYFX.CopyRight & vbCrLf
WScript.Echo objYFX.Disclaimer

' Show exchange rate from British pounds to Canadian dollars
objYFX.CurrFromISO = "GBP"
objYFX.CurrToISO   = "CAD"
WScript.Echo objYFX.CurrFromISO & " = " & objYFX.CurrFromName
WScript.Echo objYFX.CurrToISO   & " = " & objYFX.CurrToName
objYFX.Query
WScript.Echo "Exchange rate from " & objYFX.CurrFromName _
           & " to " & objYFX.CurrToName & " currently is at " _
           & objYFX.ExchangeRate
WScript.Echo "So " & objYFX.CurrFromISO _
           & " 1000 would be equivalent to " _
           & objYFX.CurrToISO & " " _
           & FormatNumber( objYFX.ExchangeRate * 1000, 2 )
WScript.Echo vbCrLf & Join( objYFX.StatusLog, vbCrLf ) & vbCrLf

' Show exchange rate from British pounds to US dollars
objYFX.CurrToISO = "USD"
WScript.Echo objYFX.CurrFromISO & " = " & objYFX.CurrFromName
WScript.Echo objYFX.CurrToISO   & " = " & objYFX.CurrToName
objYFX.Query
WScript.Echo "Exchange rate from " & objYFX.CurrFromName _
           & " to " & objYFX.CurrToName & " currently is at " _
           & objYFX.ExchangeRate
WScript.Echo "So " & objYFX.CurrFromISO _
           & " 1000 would be equivalent to " _
           & objYFX.CurrToISO & " " _
           & FormatNumber( objYFX.ExchangeRate * 1000, 2 )
WScript.Echo vbCrLf & Join( objYFX.StatusLog, vbCrLf ) & vbCrLf

' Clear the (cumulative) log
objYFX.ClearLog

' Show exchange rate from Canadian dollars to US dollars
objYFX.CurrFromISO = "CAD"
WScript.Echo objYFX.CurrFromISO & " = " & objYFX.CurrFromName
WScript.Echo objYFX.CurrToISO   & " = " & objYFX.CurrToName
objYFX.Query
WScript.Echo "Exchange rate from " & objYFX.CurrFromName _
           & " to " & objYFX.CurrToName & " currently is at " _
           & objYFX.ExchangeRate
WScript.Echo "So " & objYFX.CurrFromISO _
           & " 1000 would be equivalent to " _
           & objYFX.CurrToISO & " " _
           & FormatNumber( objYFX.ExchangeRate * 1000, 2 )
WScript.Echo vbCrLf & Join( objYFX.StatusLog, vbCrLf ) & vbCrLf

Set objYFX = Nothing

Class YFX
' This class retrieves the exchange rate for any
' two currencies from http://finance.yahoo.com
'
' Properties:
' CurrFromISO  R/W [string]    ISO 4217 currency code to convert from **
' CurrFromName R   [date]      Descriptive name of currency to convert from
' CurrToISO    R/W [date]      ISO 4217 currency code to convert to **
' CurrToName   R   [date]      Descriptive name of currency to convert to
' Disclaimer   R   [string]    Disclaimer text
' ExchangeRate R   [double]    Last known exchange rate retrieved from Yahoo
' Status       R   [integer]   Connection status number
' StatusLog    R   [array str] History of status/error messages
' StatusMsg    R   [string]    Last/current status/error messages
' Version      R   [string]    This class' version number
'
' Methods:
' ClearLog         clears the status log array
' Query            start the query for the exchange reate
'
' ** Look up currency codes at http://www.currencysystem.com/codes/
'
' Disclaimer:
' This class uses http://finance.yahoo.com to retrieve exchange rates,
' and http://www.currencysystem.com/codes/ to "translate" currency codes.
' This class will break when either Yahoo or CurrencySystem change their
' web page layout or content.
' The author of this class cannot be held responsible for any damage, direct
' nor consequential, caused by the use of or inability to use this class.
' Do not make any financial decisions based on the output of this class.
' Always use a "second source" before making any decision.
' Use this class entirely at your own risk.
'
' Change log:
' July 3, 2007     First public release
'
' Written by Rob van der Woude
' http://www.robvanderwoude.com

    ' Declare all our private, or local, variables
    Private colMatches, intLastSubMatch, objRE, strConversion
    Private strCurrencies, strDecimal, strResponse, strURL, strUserAgent
    Private m_CopyRight, m_CurrFromISO, m_CurrFromName, m_CurrToISO
    Private m_CurrToName, m_Disclaimer, m_ExchangeRate
    Private m_Status, m_StatusLog, m_StatusMsg, m_Version

    ' Initialize the variables when the class is initialized
    Private Sub Class_Initialize
        Dim objHTTP
        m_CopyRight    = "Copyright (C) 2007, Rob van der Woude, " _
                       & "http://www.robvanderwoude.com"
        m_CurrFromISO  = ""
        m_CurrFromName = ""
        m_CurrToISO    = ""
        m_CurrToName   = ""
        m_Disclaimer   = "This class uses http://finance.yahoo.com " _
                       & "to retrieve exchange rates," & vbCrLf _
                       & "and http://www.currencysystem.com/codes/ to " _
                       & """translate"" currency codes." & vbCrLf _
                       & "This class will break when either Yahoo or " _
                       & "CurrencySystem change their" & vbCrLf _
                       & "web page layout or content." & vbCrLf _
                       & "The author of this class cannot be held " _
                       & "responsible for any damage, direct" & vbCrLf _
                       & "nor consequential, caused by the use of or " _
                       & "inability to use this class." & vbCrLf _
                       & "Do not make any financial decisions based " _
                       & "on the output of this class." & vbCrLf _
                       & "Always use a ""second source"" before " _
                       & "making any decision." & vbCrLf _
                       & "Use this class entirely at your own risk." & vbCrLf
        m_ExchangeRate = 0
        m_Status       = 0
        m_StatusMsg    = "Class initialized"
        m_StatusLog    = Array( FormatDateTime( Date( ), vbShortDate ) _
                              & ", " _
                              & FormatDateTime( Time( ), vbLongTime ) _
                              & ": " & m_StatusMsg & "." )
        m_Version      = "1.00"
        ' Get the locally used decimal delimiter
        strDecimal   = Replace( FormatNumber( 0, 1, True ), "0", "" )
        strUserAgent = "Mozilla/4.0 (compatible; MSIE 6.0; Windows 98)"
        ' Retrieve currency code from currencysystem.com
        Set objHTTP = CreateObject( "WinHttp.WinHttpRequest.5.1" )
        strURL = "//www.currencysystem.com/codes/"
        objHTTP.Open "GET", strURL, False
        objHTTP.SetRequestHeader "UserAgent", strUserAgent
        objHTTP.Send
        strCurrencies = objHTTP.ResponseText
        m_Status      = objHTTP.Status
        m_StatusMsg   = "CurrencySystem.com currency codes: " _
                      & objHTTP.Status & " = " & objHTTP.StatusText
        Add2Log m_StatusMsg
        Set objHTTP = Nothing
    End Sub

    Public Property Get CopyRight
        CopyRight = m_CopyRight
    End Property

    Public Property Get CurrFromISO
        CurrFromISO = m_CurrFromISO
    End Property

    Public Property Let CurrFromISO( myCurrFrom )
        Set objRE        = New RegExp
        objRE.Global     = False
        objRE.IgnoreCase = True
        objRE.Pattern    = "[A-Z]{3}"
        Set colMatches   = objRE.Execute( myCurrFrom )
        m_StatusMsg      = myCurrFrom & " check: " _
                         & colMatches.Count & " match(es)"
        Add2Log m_StatusMsg
        If colMatches.Count = 1 Then
            m_Status       = 0
            m_CurrFromISO  = UCase( myCurrFrom )
            ' Extract the exchange rate from the CurrencySystem.com
            ' web page stored in memory; in case of error, return 0
            Set objRE        = New RegExp
            objRE.Global     = False
            objRE.IgnoreCase = False
            objRE.Pattern    = "<tr><td[ˆ>]*>([ˆ<]*)</td><td[ˆ>]*>" _
                             & UCase( myCurrFrom ) & "</td></tr>"
            Set colMatches   = objRE.Execute( strCurrencies )
            If colMatches.Count = 1 Then
                m_CurrFromName = colMatches.Item(0).Submatches(0)
            Else
                m_CurrFromName = ""
            End If
            Set colMatches = Nothing
            Set objRE      = Nothing
        Else
            m_Status    = 100
            m_StatusMsg = "Invalid currency code for " _
                        & """FROM"" currency: " & myCurrFrom
            Add2Log m_StatusMsg
        End If
        Set colMatches = Nothing
        Set objRE      = Nothing
    End Property

    Public Property Get CurrFromName
        CurrFromName = m_CurrFromName
    End Property

    Public Property Get CurrToISO
        CurrToISO = m_CurrToISO
    End Property

    Public Property Let CurrToISO( myCurrTo )
        Set objRE        = New RegExp
        objRE.Global     = False
        objRE.IgnoreCase = True
        objRE.Pattern    = "[A-Z]{3}"
        Set colMatches   = objRE.Execute( myCurrTo )
        m_StatusMsg      = myCurrTo & " check: " _
                         & colMatches.Count & " match(es)"
        Add2Log m_StatusMsg
        If colMatches.Count = 1 Then
            m_Status     = 0
            m_CurrToISO  = UCase( myCurrTo )
            ' Extract and return the exchange rate from the
            ' the web page; in case of error return 0
            Set objRE        = New RegExp
            objRE.Global     = False
            objRE.IgnoreCase = False
            objRE.Pattern    = "<tr><td[ˆ>]*>([ˆ<]*)</td><td[ˆ>]*>" _
                             & UCase( myCurrTo ) & "</td></tr>"
            Set colMatches   = objRE.Execute( strCurrencies )
            If colMatches.Count = 1 Then
                m_CurrToName = colMatches.Item(0).Submatches(0)
            Else
                m_CurrToName = ""
            End If
            Set colMatches = Nothing
            Set objRE      = Nothing
        Else
            m_Status    = 100
            m_StatusMsg = "Invalid currency code for " _
                        & """TO"" currency: " & myCurrTo
            Add2Log m_StatusMsg
        End If
        Set colMatches = Nothing
        Set objRE      = Nothing
    End Property

    Public Property Get CurrToName
        CurrToName = m_CurrToName
    End Property

    Public Property Get ExchangeRate
        ExchangeRate = m_ExchangeRate
    End Property

    Public Property Get Disclaimer
        Disclaimer = m_Disclaimer
    End Property

    Public Property Get Status
        Status = m_Status
    End Property

    Public Property Get StatusLog
        StatusLog = m_StatusLog
    End Property

    Public Property Get StatusMsg
        StatusMsg = m_StatusMsg
    End Property

    Public Property Get Version
        Version = m_Version
    End Property

    Public Sub ClearLog
        m_StatusMsg    = "Log cleared"
        m_StatusLog    = Array( FormatDateTime( Date( ), vbShortDate ) _
                              & ", " _
                              & FormatDateTime( Time( ), vbLongTime ) _
                              & ": " & m_StatusMsg & "." )
    End Sub

    Public Function Query
        Dim objHTTP
        ' Retrieve Yahoo's web page containing our currencies' exchange rate
        Set objHTTP = CreateObject( "WinHttp.WinHttpRequest.5.1" )
        strURL = "//finance.yahoo.com/q?s=" _
               & UCase( m_CurrFromISO & m_CurrToISO ) & "=X"
        objHTTP.Open "GET", strURL, False
        objHTTP.SetRequestHeader "UserAgent", strUserAgent
        objHTTP.Send
        strResponse = objHTTP.ResponseText
        m_Status    = objHTTP.Status
        m_StatusMsg = "Yahoo Finance Currency Converter: " _
                    & objHTTP.Status & " = " & objHTTP.StatusText
        Add2Log m_StatusMsg
        Set objHTTP = Nothing

        ' Extract and return the exchange rate from
        ' the web page; in case of error return 0
        Set objRE        = New RegExp
        objRE.Global     = False
        objRE.IgnoreCase = True
        objRE.Pattern    = ">Last Trade:(<[ˆ>]+>)+([.0-9]+)<[ˆ>]+>"
        Set colMatches   = objRE.Execute( strResponse )
        m_StatusMsg      = "Exchange rate search: " _
                         & colMatches.Count & " match(es)"
        Add2Log m_StatusMsg
        If colMatches.Count = 1 Then
            intLastSubMatch = colMatches.Item(0).Submatches.Count - 1
            strConversion   = colMatches.Item(0).Submatches( intLastSubMatch )
            If IsNumeric( strConversion ) Then
                ' Convert the match from string to number,
                ' using the local decimal delimiter
                m_Status    = 0
                m_StatusMsg = "Exchange rate found: " & strConversion
                Add2Log m_StatusMsg
                strConversion  = CDbl( Replace( strConversion, ".", strDecimal ) )
                m_ExchangeRate = strConversion
            Else
                m_Status    = 100
                m_StatusMsg = "No numeric exchange rate found: " & strConversion
                Add2Log m_StatusMsg
                m_ExchangeRate = 0
            End If
        Else
            m_Status    = 100
            m_StatusMsg = "No exchange rate found"
            Add2Log m_StatusMsg
            m_ExchangeRate = 0
        End If
        Set colMatches = Nothing
        Set objRE      = Nothing
        m_Status    = 0
        m_StatusMsg = "Ready"
        Add2Log m_StatusMsg
    End Function

    Private Sub Add2Log( myLine )
        ReDim Preserve m_StatusLog( UBound( m_StatusLog ) + 1 )
        m_StatusLog( UBound( m_StatusLog ) ) = FormatDateTime( Date( ), vbShortDate ) _
                                             & ", " _
                                             & FormatDateTime( Time( ), vbLongTime ) _
                                             & ": " & myLine & "."
    End Sub
End Class
Sample Output:
Class "YahooFX", Version 1.00
Copyright (C) 2007, Rob van der Woude, http://www.robvanderwoude.com

This class uses http://finance.yahoo.com to retrieve exchange rates,
and http://www.currencysystem.com/codes/ to "translate" currency codes.
This class will break when either Yahoo or CurrencySystem change their
web page layout or content.
The author of this class cannot be held responsible for any damage, direct
nor consequential, caused by the use of or inability to use this class.
Do not make any financial decisions based on the output of this class.
Always use a "second source" before making any decision.
Use this class entirely at your own risk.

GBP = British pound
CAD = Canadian dollar
Exchange rate from British pound to Canadian dollar currently is at 2,1302
So GBP 1000 would be equivalent to CAD 2.130,20

02-07-2007, 23:13:33: Class initialized.
02-07-2007, 23:13:36: CurrencySystem.com currency codes: 200 = OK.
02-07-2007, 23:13:36: GBP check: 1 match(es).
02-07-2007, 23:13:36: CAD check: 1 match(es).
02-07-2007, 23:13:37: Yahoo Finance Currency Converter: 200 = OK.
02-07-2007, 23:13:37: Exchange rate search: 1 match(es).
02-07-2007, 23:13:37: Exchange rate found: 2.1302.
02-07-2007, 23:13:37: Ready.

GBP = British pound
USD = US dollar
Exchange rate from British pound to US dollar currently is at 2,0172
So GBP 1000 would be equivalent to USD 2.017,20

02-07-2007, 23:13:33: Class initialized.
02-07-2007, 23:13:36: CurrencySystem.com currency codes: 200 = OK.
02-07-2007, 23:13:36: GBP check: 1 match(es).
02-07-2007, 23:13:36: CAD check: 1 match(es).
02-07-2007, 23:13:37: Yahoo Finance Currency Converter: 200 = OK.
02-07-2007, 23:13:37: Exchange rate search: 1 match(es).
02-07-2007, 23:13:37: Exchange rate found: 2.1302.
02-07-2007, 23:13:37: Ready.
02-07-2007, 23:13:37: USD check: 1 match(es).
02-07-2007, 23:13:38: Yahoo Finance Currency Converter: 200 = OK.
02-07-2007, 23:13:38: Exchange rate search: 1 match(es).
02-07-2007, 23:13:38: Exchange rate found: 2.0172.
02-07-2007, 23:13:38: Ready.

CAD = Canadian dollar
USD = US dollar
Exchange rate from Canadian dollar to US dollar currently is at 0,947
So CAD 1000 would be equivalent to USD 947,00

02-07-2007, 23:13:38: Log cleared.
02-07-2007, 23:13:38: CAD check: 1 match(es).
02-07-2007, 23:13:39: Yahoo Finance Currency Converter: 200 = OK.
02-07-2007, 23:13:39: Exchange rate search: 1 match(es).
02-07-2007, 23:13:39: Exchange rate found: 0.9470.
02-07-2007, 23:13:39: Ready.
 
Requirements:
Windows version: 2000 SP3, XP, Server 2003, or Vista
Network: any
Client software: Internet Explorer 5.01
Script Engine: any
Summarized: Works in Windows 2000 SP3 or later.
Should work in Windows 95, 98, ME, or NT 4 with Internet Explorer 5.01 or later.
 
[Back to the top of this page]

page last modified: 2016-09-19; loaded in 0.0018 seconds