Get updated currencies for europe


DevX Home    Today's Headlines   Articles Archive   Tip Bank   Forums   

Results 1 to 2 of 2

Thread: Get updated currencies for europe

  1. #1
    Join Date
    Aug 2004
    Posts
    43,023

    Get updated currencies for europe

    [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 )

  2. #2
    Join Date
    Aug 2004
    Posts
    43,023

    Re:Get updated currencies for europe

    [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
    *********************************

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  
HTML5 Development Center
 
 
FAQ
Latest Articles
Java
.NET
XML
Database
Enterprise
Questions? Contact us.
C++
Web Development
Wireless
Latest Tips
Open Source


   Development Centers

   -- Android Development Center
   -- Cloud Development Project Center
   -- HTML5 Development Center
   -- Windows Mobile Development Center