Într-un articol precedent v-am explicat cum puteţi prelua cursul valutar de pe site-ul BNR folosind un script, html, etc.
Acum, revin cu o actualizare şi anume, am eliminat acel script care salva pagina în format HTML, dar şi codul care prelucra pagina.

Noul cod iniţiază o nouă sesiune de browser şi interpretează codul HTML al paginii, iar la urmă afişează datele de interes într-un formular.
Un alt exemplu îl aveţi aici: [Aplicaţie] – Validare cod CIF în Microsoft Access

Codul folosit este:

'---------------------------------------------------------------------------------------
' Modul     : Form_frmCheckCurs
' Autor     : Alexandru Dionisie
' Data      : 04.12.2011
' WebSite   : www.tutorialeoffice.ro
' Sursa Cod : -
' Scop      : Codul de mai jos afiseaza cursul valutar in campurile unui formular.
' Observatii: Pentru a rula pe SO: Windows 7 si browser-ul IE9, este nevoie sa:
'               1. mergeti in Tools - References si sa puneti o bifa
'                     librariei Microsoft Internet Controls.
'               2. In IE 9, mergeti in Tools - Compatibility View Settings
'                     si sa bifati optiunea Display All Websites in Compatibility View.
'---------------------------------------------------------------------------------------
Option Compare Database
'declaratii pentru testarea conexiunii la internet
Private Declare Function InternetGetConnectedStateEx Lib "wininet.dll" _
                                                     (ByRef lpdwFlags As Long, ByVal lpszConnectionName As String, _
                                                      ByVal dwNameLen As Integer, ByVal dwReserved As Long) As Long
Dim sConnType As String * 255
Private Sub cmdCheck_Click()
    On Error GoTo err
    Dim Ret As Long
    Dim ie As Object
    Dim strSource As String, strEuro As String, strDolar As String
    'ascundem avertizarea pentru net
    lblNet.Visible = False
            'golim textbox-urile
            txtEuro.SetFocus
            txtEuro.Text = ""
            txtDolar.SetFocus
            txtDolar.Text = ""
            txtConvD.SetFocus
            txtConvD.Text = ""
            txtConvE.SetFocus
            txtConvE.Text = ""
    'se verifica starea conexiunii
    'este legat de If Ret = 1 Then
    Ret = InternetGetConnectedStateEx(Ret, sConnType, 254, 0)
    'cream o noua instanta de IE
    Set ie = CreateObject("internetexplorer.application")
    'ascundem fereastra browser-ului
    ie.Visible = False
    'deschidem link-ul creat
    ie.Navigate "http://bnr.ro/Home.aspx"
    'asteptam sa se incarca complet pagina
TryAgain:
    While ie.Busy
        DoEvents
    Wend
    'extragem outerHTML - contine XML-ul paginii
    On Error GoTo TryAgain
    strSource = ie.Document.body.outerHTML
    'daca avem conexiune la internet, rezultatul este 1 adica TRUE si se trece la rularea codului
    If Ret = 1 Then
        'daca pagina nu este valida, afisam mesaj de eroare
        If ie.Document.title = "HTTP 404 Not Found" Then
            'lblStatus.Visible = True
            'golim textbox-urile
            txtEuro.SetFocus
            txtEuro.Text = ""
            txtDolar.SetFocus
            txtDolar.Text = ""
            txtConvD.SetFocus
            txtConvD.Text = ""
            txtConvE.SetFocus
            txtConvE.Text = ""
        Else
            On Error GoTo 0
            'eliminam tag-urile html - Euro
            strSource = Mid(strSource, InStr(1, strSource, _
                                             "1 EUR") + 22)
            'preluam doar valoarea de interes - Euro
            strEuro = Left(strSource, 6)
            'eliminam tag-urile html - Dolar
            strSource = Mid(strSource, InStr(1, strSource, _
                                             "1 USD") + 22)
            'preluam doar valoarea de interes - Dolar
            strDolar = Left(strSource, 6)
            'afisam toate datele in TextBox-uri
            txtEuro.SetFocus
            txtEuro.Text = strEuro & " lei"
            txtDolar.SetFocus
            txtDolar.Text = strDolar & " lei"
            'eliminam procesul din memorie
            ie.Quit
            'realizam conversia EURO - RON si USD - RON
            txtConvE = txtSumaE * txtEuro
            txtConvD = txtSumaD * txtDolar
        End If
    Else
        'daca nu avem conexiune la internet, rezultatul este 0 adica FALSE
        'se afiseaza un label cu un text informativ
        lblNet.Visible = True
    End If
    Exit Sub
err:
    MsgBox err.Description, vbOKOnly + vbInformation, "Eroare"
End Sub

Download | Preluare_Curs.accdb
Download | Preluare_Curs.mdb


UPDATE:
Dat fiind faptul că în weekend cursul valutar nu se actualizează, am decis să mai adaug câteva linii de cod care să:
– afişeze data cursului;

– dacă data la care a fost adăugat cursul nu este identică cu data curentă, să afişeze o notificare, dar totuşi să preia cursul.

Întreg codul este comentat, deci nu va fi nicio problemă în a-l interpreta.
Pentru fişierele de lucru, folosiţi link-urile de download de mai sus.
Noul cod este:

'---------------------------------------------------------------------------------------
' Modul     : Form_frmCheckCurs
' Autor     : Alexandru Dionisie
' Data      : 04.12.2011
' WebSite   : www.tutorialeoffice.ro
' Sursa Cod : -
' Scop      : Codul de mai jos afiseaza cursul valutar in campurile unui formular.
' Observatii: Pentru a rula pe SO: Windows 7 si browser-ul IE9, este nevoie sa:
'               1. mergeti in Tools - References si sa puneti o bifa
'                     librariei Microsoft Internet Controls.
'               2. In IE 9, mergeti in Tools - Compatibility View Settings
'                     si sa bifati optiunea Display All Websites in Compatibility View.
'---------------------------------------------------------------------------------------
Option Compare Database
'declaratii pentru testarea conexiunii la internet
Private Declare Function InternetGetConnectedStateEx Lib "wininet.dll" _
                                                     (ByRef lpdwFlags As Long, ByVal lpszConnectionName As String, _
                                                      ByVal dwNameLen As Integer, ByVal dwReserved As Long) As Long
Dim sConnType As String * 255
Private Sub cmdCheck_Click()
    On Error GoTo err
    Dim Ret As Long
    Dim ie As Object
    Dim strSource As String, strEuro As String, strDolar As String, strCN As String
    'ascundem avertizarea pentru net
    lblNet.Visible = False
    'ascundem avertizarea pentru curs expirat
    lblData.Visible = False
    'ascundem label-ul pentru data
    txtDataCurs.Visible = False
    'golim textbox-urile
    txtEuro.SetFocus
    txtEuro.Text = ""
    txtDolar.SetFocus
    txtDolar.Text = ""
    txtConvD.SetFocus
    txtConvD.Text = ""
    txtConvE.SetFocus
    txtConvE.Text = ""
    'se verifica starea conexiunii
    'este legat de If Ret = 1 Then
    Ret = InternetGetConnectedStateEx(Ret, sConnType, 254, 0)
    'cream o noua instanta de IE
    Set ie = CreateObject("internetexplorer.application")
    'ascundem fereastra browser-ului
    ie.Visible = False
    'deschidem link-ul creat
    ie.Navigate "http://bnr.ro/Home.aspx"
    'asteptam sa se incarca complet pagina
TryAgain:
    While ie.Busy
        DoEvents
    Wend
    'extragem outerHTML - contine XML-ul paginii
    On Error GoTo TryAgain
    strSource = ie.Document.body.outerHTML
    'daca avem conexiune la internet, rezultatul este 1 adica TRUE si se trece la rularea codului
    If Ret = 1 Then
        'daca pagina este invalida, afisam mesaj de eroare
        If ie.Document.title = "HTTP 404 Not Found" Then
            'lblStatus.Visible = True
            'golim textbox-urile
            txtEuro.SetFocus
            txtEuro.Text = ""
            txtDolar.SetFocus
            txtDolar.Text = ""
            txtConvD.SetFocus
            txtConvD.Text = ""
            txtConvE.SetFocus
            txtConvE.Text = ""
        Else
            On Error GoTo 0
            'eliminam tag-urile html - pentru data cursului
            strSource = Mid(strSource, InStr(1, strSource, _
                                             "rates") + 62)
            'verificam data noului curs
            strCN = Left(strSource, 10)
            'daca data de pe site este = cu data curenta, ruleaza codul
            If strCN = Date Then
                'afisam label-ul pentru data
                txtDataCurs.Visible = True
                'deblocam textbox-ul
                txtDataCurs.Locked = False
                'stabilim focusul pe textbox-ul cu data
                txtDataCurs.SetFocus
                'afisam data curenta
                txtDataCurs.Text = "Cursul este din data de: " & strCN
                'blocam textbox-ul
                txtDataCurs.Locked = True
                'rulam procedura de preluare a cursului
Demo:
                'eliminam tag-urile html - Euro
                strSource = Mid(strSource, InStr(1, strSource, _
                                                 "1 EUR") + 22)
                'preluam doar valoarea de interes - Euro
                strEuro = Left(strSource, 6)
                'eliminam tag-urile html - Dolar
                strSource = Mid(strSource, InStr(1, strSource, _
                                                 "1 USD") + 22)
                'preluam doar valoarea de interes - Dolar
                strDolar = Left(strSource, 6)
                'afisam toate datele in TextBox-uri
                txtEuro.SetFocus
                txtEuro.Text = strEuro & " lei"
                txtDolar.SetFocus
                txtDolar.Text = strDolar & " lei"
                'eliminam procesul din memorie
                ie.Quit
                'realizam conversia EURO - RON si USD - RON
                txtConvE = txtSumaE * txtEuro
                txtConvD = txtSumaD * txtDolar
            Else
                'daca data curenta =/= de data de pe site, afiseaza mesaj in label
                'si ruleaza codul oricum
                lblData.Visible = True
                'afisam label-ul pentru data
                txtDataCurs.Visible = True
                'deblocam textbox-ul
                txtDataCurs.Locked = False
                'stabilim focusul pe textbox-ul cu data
                txtDataCurs.SetFocus
                'afisam data curenta
                txtDataCurs.Text = "Cursul este din data de: " & strCN
                'blocam textbox-ul
                txtDataCurs.Locked = True
                'rulam codul de preluare a cursului, daca se indeplineste conditia Today=Date
                GoTo Demo
            End If
        End If
    Else
        'daca nu avem conexiune la internet, rezultatul este 0 adica FALSE
        'se afiseaza un label cu un text informativ
        lblNet.Visible = True
    End If
    Exit Sub
err:
    MsgBox err.Description, vbOKOnly + vbInformation, "Eroare"
End Sub
Back To Top
Search