VBScript Scripting Techniques > Network > Yahoo Exchange Rates
| WinHTTP (Function) | |
|---|---|
| VBScript Code: | |
|
Option Explicit Dim dblAmount, strFromCurr, strToCurr dblAmount = 1987.23 strFromCurr = "USD" strToCurr = "EUR" WScript.Echo YahooFX( dblAmount, strFromCurr, strToCurr ) dblAmount = 2001.17 strFromCurr = "USD" strToCurr = "DKK" WScript.Echo YahooFX( dblAmount, strFromCurr, strToCurr ) Function YahooFX( myAmount, myFromCur, myToCur ) Dim dblConvert, dblExch If IsNumeric( myAmount ) Then ' Amount should be greater than zero If myAmount <= 0 Then YahooFX = "Error: " & myAmount & " is not a valid amount" Exit Function End If Else ' Amount should at least be a number YahooFX = "Error: " & myAmount & " is not a valid amount" Exit Function End If ' Retrieve the exchange rate for these currencies dblConvert = YahooTrade( myFromCur, myToCur ) If dblConvert = 0 Then YahooFX = "Error retrieving exchange rate" Else ' Format the screen output dblExch = FormatNumber( dblConvert * myAmount, 2, True, False, False ) YahooFX = myFromCur & " " & myAmount & " = " & myToCur & " " & dblExch End If End Function Function YahooTrade( myFromCurr, myToCurr ) ' This function retrieves the exchange rate ' for any two currencies from finance.yahoo.com ' ' Arguments: ' myFromCurr [string] ISO 4217 3 letter code for the currency to convert from ' myToCurr [string] ISO 4217 3 letter code for the currency to convert to ' ' Look up currency codes at http://www.oanda.com/site/help/iso_code.shtml ' ' Returns: ' Conversion rate as number ' ' Disclaimer: ' This script uses http://finance.yahoo.com to retrieve exchange rates. ' This script will break when Yahoo changes its web page layout or content. ' The author of this script cannot be held responsible for any damage, direct ' nor consequential, caused by the use of or inability to use this script. ' Do not make any financial decisions based on the output of this script. ' Always use a "second source" before making any decision. ' Use this script entirely at your own risk. ' ' Written by Rob van der Woude ' http://www.robvanderwoude.com Dim colMatches, intLastSubMatch, objHTTP, objRE, strConversion Dim strDecimal, strMyAmount, strResponse, strURL, strUserAgent ' Get the locally used decimal delimiter strDecimal = Replace( FormatNumber( 0, 1, True ), "0", "" ) ' Retrieve Yahoo's web page containing the our currencies' exchange rate Set objHTTP = CreateObject( "WinHttp.WinHttpRequest.5.1" ) strURL = "//finance.yahoo.com/q?s=" & myFromCurr & myToCurr & "=X" objHTTP.Open "GET", strURL, False strUserAgent = "Mozilla/4.0 (compatible; MSIE 6.0; Windows 98)" objHTTP.SetRequestHeader "UserAgent", strUserAgent objHTTP.Send strResponse = objHTTP.ResponseText 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 ) 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 strConversion = CDbl( Replace( strConversion, ".", strDecimal ) ) YahooTrade = strConversion Else YahooTrade = 0 End If Else YahooTrade = 0 End If Set colMatches = Nothing Set objRE = Nothing End Function |
|
| Sample Output: | |
|
USD 1987,23 = EUR 1462,40 USD 2001,17 = DKK 10961,01 |
|
| 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.0069 seconds
