Get updated currencies for europe

[anonymous]

[Originally posted by mike]

hi i am having some trouble with a p;roject for college and i got some code off of the net to search the net for the exchange rates of europe but it does not work can some one help me plz

Private Sub cmdGet_Click()
ÿ ÿ Screen.MousePointer = 11
ÿ ÿ 'get new exchange rates
ÿ ÿ Inet1.URL = "http://uk.moneyentral.msn.com/investor/market/rates.asp?Region=Europe"
ÿ ÿ rtbMain.Text = Inet1.OpenURL
ÿ ÿ rtbMain.Text = Replace(rtbMain.Text, Chr(34), "")
ÿ ÿ 'parse the HTML
ÿ ÿ 'get start point
ÿ ÿ a = InStr(1, rtbMain.Text, "Value of 1 Euro") + 16
ÿ ÿ 'get currency names
ÿ ÿ Dim iStart As Long
ÿ ÿ iStart = 1
ÿ ÿ
ÿ ÿ Do
ÿ ÿ ÿ ÿ b = InStr(iStart, rtbMain.Text, "nbsp;ÿÿÿ")
ÿ ÿ ÿ ÿ If b = 0 Then Exit Do
ÿ ÿ ÿ ÿ b = b + 28
ÿ ÿ ÿ ÿ c = InStr(b, rtbMain.Text, "font") - 2
ÿ ÿ ÿ ÿ cName = Mid(rtbMain.Text, b, c - b)
ÿ ÿ ÿ ÿ lstCurrency.AddItem cName
ÿ ÿ ÿ ÿ
ÿ ÿ ÿ ÿ d = InStr(c, rtbMain.Text, "html>") + 5
ÿ ÿ ÿ ÿ e = InStr(d, rtbMain.Text, &quot;</a>&quot;)
ÿ ÿ ÿ ÿ vName = Mid(rtbMain.Text, d, e - d)
ÿ ÿ ÿ ÿ lstRate.AddItem vName
ÿ ÿ ÿ ÿ
ÿ ÿ ÿ ÿ iStart = e
ÿ ÿ ÿ ÿ
ÿ ÿ Loop
ÿ ÿ
ÿ ÿ Screen.MousePointer = 0
ÿ ÿ
End Sub

(the code i was given )

[anonymous]

[Originally posted by Frank]

I just made a program that downloads exchange rates from the monetary fund and updates them to a MySQL database.
They have a new downloadable csv file every day. This file is downloaded and scanned and the values are updated in the database.
To find the exchange rate from i.e. Punds to Dollars find the value for Punds and divided by the value for dollars that will give you the amount of punds for one dollars (or was it the other way around, you'll figure it out)

The vb program needs:
msinet.ocx
scrrun.dll (filesystemobject)
msado25.tlb or higher

Here is the code:
It recuires a Button named cmdGo and a textbox named txtText.Text. The database fields can be found in the SQL string...

***********************************
Option Explicit

Private Sub cmdGo_Click()

ÿ ÿ On Error GoTo Error
ÿ ÿ
ÿ ÿ Dim strData As String
ÿ ÿ Dim strArchive As String
ÿ ÿ Dim strPath As String
ÿ ÿ Dim strFile As String
ÿ ÿ Dim strTemp As String
ÿ ÿ Dim strSplit() As String
ÿ ÿ Dim intEuro As Integer
ÿ ÿ Dim bWrite As Boolean
ÿ ÿ Dim fso As New FileSystemObject
ÿ ÿ Dim fsoOut As TextStream
ÿ ÿ Dim fsoIn As TextStream
ÿ ÿ Dim cnnMain As New Connection
ÿ ÿ Dim rsData As New Recordset
ÿ ÿ Dim strSQL As String
ÿ ÿ Dim intCurrency As Integer
ÿ ÿ Dim intRep As Integer
ÿ ÿ Dim intLoc As Integer
ÿ ÿ Dim intStart As Integer
ÿ ÿ Dim intEnd As Integer
ÿ ÿ Dim strDate As String
ÿ ÿ Dim datDate As Date
ÿ ÿ Dim intDay As Integer
ÿ ÿ Dim dblRate As Double
ÿ ÿ Dim varDBUser As String
ÿ ÿ Dim varDBPassword As String
ÿ ÿ Dim varDBServer As String
ÿ ÿ Dim varDBDatabase As String
ÿ ÿ Dim varDBString As String
ÿ ÿ Dim strYear As String
ÿ ÿ Dim strMonth As String
ÿ ÿ Dim strDay As String
ÿ ÿ
ÿ ÿ cmdGo.Enabled = False
ÿ ÿ
ÿ ÿ ' Settings
ÿ ÿ strArchive = "D:\Files\Storage\XRates\"
ÿ ÿ
ÿ ÿ ' Get Data from Monetary Fund
ÿ ÿ strData = inetControl.OpenURL("http://www.imf.org/external/np/tre/sdr/db/rms_fpt.cfm")
ÿ ÿ
ÿ ÿ ' Get Daye
ÿ ÿ intLoc = InStr(1, strData, "Currency Name")
ÿ ÿ intStart = InStr(intLoc, strData, Chr(9))
ÿ ÿ intEnd = InStr(intStart + 1, strData, Chr(9))
ÿ ÿ strDate = Mid(strData, intStart + 2, intEnd - intStart - 3)
ÿ ÿ strDate = Trim(strDate)
ÿ ÿ strYear = Right(strDate, 4)
ÿ ÿ strDate = Left(strDate, Len(strDate) - 5)
ÿ ÿ intLoc = InStr(1, strDate, " ")
ÿ ÿ strMonth = Left(strDate, intLoc - 1)
ÿ ÿ strDay = Right(strDate, Len(strDate) - intLoc)
ÿ ÿ Select Case strMonth
ÿ ÿ Case "January"
ÿ ÿ ÿ ÿ strMonth = "1"
ÿ ÿ Case "February"
ÿ ÿ ÿ ÿ strMonth = "2"
ÿ ÿ Case "March"
ÿ ÿ ÿ ÿ strMonth = "3"
ÿ ÿ Case "April"
ÿ ÿ ÿ ÿ strMonth = "4"
ÿ ÿ Case "May"
ÿ ÿ ÿ ÿ strMonth = "5"
ÿ ÿ Case "June"
ÿ ÿ ÿ ÿ strMonth = "6"
ÿ ÿ Case "July"
ÿ ÿ ÿ ÿ strMonth = "7"
ÿ ÿ Case "August"
ÿ ÿ ÿ ÿ strMonth = "8"
ÿ ÿ Case "September"
ÿ ÿ ÿ ÿ strMonth = "9"
ÿ ÿ Case "October"
ÿ ÿ ÿ ÿ strMonth = "10"
ÿ ÿ Case "November"
ÿ ÿ ÿ ÿ strMonth = "11"
ÿ ÿ Case "December"
ÿ ÿ ÿ ÿ strMonth = "12"
ÿ ÿ End Select
ÿ ÿ datDate = CDate(strDay & "/" & strMonth & "/" & strYear)
ÿ ÿ
ÿ ÿ ' Save Data to File
ÿ ÿ strPath = strArchive & CStr(Year(datDate))
ÿ ÿ If Not fso.FolderExists(strPath) Then fso.CreateFolder (strPath)
ÿ ÿ
ÿ ÿ If Month(datDate) < 10 Then strTemp = "0" Else strTemp = ""
ÿ ÿ strPath = strPath & "\" & strTemp & CStr(Month(datDate)) & " " & MonthName(Month(datDate), False)
ÿ ÿ If Not fso.FolderExists(strPath) Then fso.CreateFolder (strPath)
ÿ ÿ strPath = strPath & "\"
ÿ ÿ
ÿ ÿ If Day(datDate) < 10 Then strTemp = "0" Else strTemp = ""
ÿ ÿ strFile = strPath & strTemp & CStr(Day(datDate)) & ".csv"
ÿ ÿ Set fsoOut = fso.OpenTextFile(strFile, ForWriting, True)
ÿ ÿ fsoOut.Write strData
ÿ ÿ fsoOut.Close
ÿ ÿ
ÿ ÿ ' Process Data from File
ÿ ÿ varDBUser = "root"
ÿ ÿ varDBPassword = "dbpassword"
ÿ ÿ varDBServer = "localhost"
ÿ ÿ varDBDatabase = "database"
ÿ ÿ varDBString = "Driver={MySQL};"
ÿ ÿ varDBString = varDBString & "Server=" & varDBServer & ";"
ÿ ÿ varDBString = varDBString & "UID=" & varDBUser & ";"
ÿ ÿ varDBString = varDBString & "PWD=" & varDBPassword & ";"
ÿ ÿ varDBString = varDBString & "Database=" & varDBDatabase
ÿ ÿ
ÿ ÿ cnnMain.Open varDBString
ÿ ÿ
ÿ ÿ Set fsoIn = fso.OpenTextFile(strFile, ForReading, False)
ÿ ÿ
ÿ ÿ bWrite = False
ÿ ÿ intEuro = 0
ÿ ÿ txtText.Text = ""
ÿ ÿ While Not fsoIn.AtEndOfStream
ÿ ÿ ÿ ÿ strData = Trim(fsoIn.ReadLine)
ÿ ÿ ÿ ÿ strData = Replace(strData, Chr(34), "")
ÿ ÿ ÿ ÿ
ÿ ÿ ÿ ÿ If Left(strData, 4) = "Euro" Then intEuro = intEuro + 1
ÿ ÿ ÿ ÿ If intEuro = 2 Then bWrite = True
ÿ ÿ ÿ ÿ
ÿ ÿ ÿ ÿ If Left(strData, 5) = "Notes" Then bWrite = False
ÿ ÿ ÿ ÿ
ÿ ÿ ÿ ÿ strSplit() = Split(strData, Chr(9))
ÿ ÿ ÿ ÿ If UBound(strSplit) < 5 Then bWrite = False
ÿ ÿ ÿ ÿ
ÿ ÿ ÿ ÿ For intRep = 0 To UBound(strSplit)
ÿ ÿ ÿ ÿ ÿ ÿ strSplit(intRep) = Trim(strSplit(intRep))
ÿ ÿ ÿ ÿ Next
ÿ ÿ ÿ ÿ
ÿ ÿ ÿ ÿ If bWrite Then
ÿ ÿ ÿ ÿ ÿ ÿ strSQL = "SELECT * FROM currency WHERE currency_strName = '" & strSplit(0) & "' LIMIT 0, 1"
ÿ ÿ ÿ ÿ ÿ ÿ Set rsData = cnnMain.Execute(strSQL)
ÿ ÿ ÿ ÿ ÿ ÿ
ÿ ÿ ÿ ÿ ÿ ÿ If rsData.EOF And rsData.BOF Then
ÿ ÿ ÿ ÿ ÿ ÿ ÿ ÿ strSQL = "INSERT INTO currency ("
ÿ ÿ ÿ ÿ ÿ ÿ ÿ ÿ strSQL = strSQL & "currency_strName) "
ÿ ÿ ÿ ÿ ÿ ÿ ÿ ÿ strSQL = strSQL & "VALUES ("
ÿ ÿ ÿ ÿ ÿ ÿ ÿ ÿ strSQL = strSQL & "'" & strSplit(0) & "') "
ÿ ÿ ÿ ÿ ÿ ÿ ÿ ÿ cnnMain.Execute strSQL
ÿ ÿ ÿ ÿ ÿ ÿ ÿ ÿ
ÿ ÿ ÿ ÿ ÿ ÿ ÿ ÿ strSQL = "SELECT * FROM currency WHERE currency_strName = '" & strSplit(0) & "' LIMIT 0, 1"
ÿ ÿ ÿ ÿ ÿ ÿ ÿ ÿ Set rsData = cnnMain.Execute(strSQL)
ÿ ÿ ÿ ÿ ÿ ÿ End If
ÿ ÿ ÿ ÿ ÿ ÿ
ÿ ÿ ÿ ÿ ÿ ÿ intCurrency = CInt(rsData("currency_intID"))
ÿ ÿ ÿ ÿ ÿ ÿ
ÿ ÿ ÿ ÿ ÿ ÿ For intDay = 0 To 4
ÿ ÿ ÿ ÿ ÿ ÿ ÿ ÿ strDate = Year(datDate - intDay) & "/" & Month(datDate - intDay) & "/" & Day(datDate - intDay)
ÿ ÿ ÿ ÿ ÿ ÿ ÿ ÿ strSQL = "SELECT * FROM xrates WHERE xrates_intCurrencyID = '" & intCurrency & "' AND xrates_datDate = '" & strDate & "' LIMIT 0, 1"
ÿ ÿ ÿ ÿ ÿ ÿ ÿ ÿ Set rsData = cnnMain.Execute(strSQL)
ÿ ÿ ÿ ÿ ÿ ÿ ÿ ÿ
ÿ ÿ ÿ ÿ ÿ ÿ ÿ ÿ If rsData.EOF And rsData.BOF Then
ÿ ÿ ÿ ÿ ÿ ÿ ÿ ÿ ÿ ÿ strSQL = "INSERT INTO xrates ("
ÿ ÿ ÿ ÿ ÿ ÿ ÿ ÿ ÿ ÿ strSQL = strSQL & "xrates_intCurrencyID, "
ÿ ÿ ÿ ÿ ÿ ÿ ÿ ÿ ÿ ÿ strSQL = strSQL & "xrates_datDate, "
ÿ ÿ ÿ ÿ ÿ ÿ ÿ ÿ ÿ ÿ strSQL = strSQL & "xrates_dblRate) "
ÿ ÿ ÿ ÿ ÿ ÿ ÿ ÿ ÿ ÿ strSQL = strSQL & "VALUES ("
ÿ ÿ ÿ ÿ ÿ ÿ ÿ ÿ ÿ ÿ strSQL = strSQL & "'" & intCurrency & "', "
ÿ ÿ ÿ ÿ ÿ ÿ ÿ ÿ ÿ ÿ strSQL = strSQL & "'" & strDate & "', "
ÿ ÿ ÿ ÿ ÿ ÿ ÿ ÿ ÿ ÿ strSQL = strSQL & "'" & strSplit(1 + intDay) & "')"
ÿ ÿ ÿ ÿ ÿ ÿ ÿ ÿ ÿ ÿ
ÿ ÿ ÿ ÿ ÿ ÿ ÿ ÿ ÿ ÿ cnnMain.Execute strSQL
ÿ ÿ ÿ ÿ ÿ ÿ ÿ ÿ Else
ÿ ÿ ÿ ÿ ÿ ÿ ÿ ÿ ÿ ÿ strSQL = "UPDATE xrates SET "
ÿ ÿ ÿ ÿ ÿ ÿ ÿ ÿ ÿ ÿ strSQL = strSQL & "xrates_dblRate = '" & strSplit(1 + intDay) & "' "
ÿ ÿ ÿ ÿ ÿ ÿ ÿ ÿ ÿ ÿ strSQL = strSQL & "WHERE xrates_intCurrencyID = '" & intCurrency & "' "
ÿ ÿ ÿ ÿ ÿ ÿ ÿ ÿ ÿ ÿ strSQL = strSQL & "AND xrates_datDate = '" & strDate & "'"
ÿ ÿ ÿ ÿ ÿ ÿ ÿ ÿ ÿ ÿ
ÿ ÿ ÿ ÿ ÿ ÿ ÿ ÿ ÿ ÿ cnnMain.Execute strSQL
ÿ ÿ ÿ ÿ ÿ ÿ ÿ ÿ End If
ÿ ÿ ÿ ÿ ÿ ÿ Next
ÿ ÿ ÿ ÿ ÿ ÿ
ÿ ÿ ÿ ÿ ÿ ÿ txtText.Text = txtText.Text & strSplit(0) & " = " & strSplit(2) & vbCrLf
ÿ ÿ ÿ ÿ End If
ÿ ÿ Wend
ÿ ÿ
ÿ ÿ fsoIn.Close
ÿ ÿ cnnMain.Close
ÿ ÿ cmdGo.Enabled = True
ÿ ÿ
Exit Sub

Error:
ÿ ÿ MsgBox Err.Description, vbCritical, "Error"

End Sub
*********************************