Î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.Tutoriale-Office.com' 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 internetPrivate Declare Function InternetGetConnectedStateEx Lib "wininet.dll" _ (ByRef lpdwFlags As Long, ByVal lpszConnectionName As String, _ ByVal dwNameLen As Integer, ByVal dwReserved As Long) As LongDim sConnType As String * 255Private 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, dupa ce preluam cif-ul din formular ie.Navigate "http://bnr.ro/Home.aspx" 'asteptam sa se incarca complet paginaTryAgain: 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 CIF-ul nu este valid, 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 Suberr: MsgBox err.Description, vbOKOnly + vbInformation, "Eroare"End SubDownload | 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.Tutoriale-Office.com' 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 internetPrivate Declare Function InternetGetConnectedStateEx Lib "wininet.dll" _ (ByRef lpdwFlags As Long, ByVal lpszConnectionName As String, _ ByVal dwNameLen As Integer, ByVal dwReserved As Long) As LongDim sConnType As String * 255Private 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, dupa ce preluam cif-ul din formular ie.Navigate "http://bnr.ro/Home.aspx" 'asteptam sa se incarca complet paginaTryAgain: 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 CIF-ul nu este valid, 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 cursuluiDemo: '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 Suberr: MsgBox err.Description, vbOKOnly + vbInformation, "Eroare"End Sub Categorie: - MS Access, - MS VBA, 4) Aplicaţii Etichete: curs valutar, dolar, euro, form, html, vba
Despre Alexandru Dionisie Alexandru Dionisie este un tânăr pasionat de domeniul IT, în special de partea de aplicaţii de tip Office, dar şi de administrare MS Windows.Acesta publică diverse articole legate de programele din suita Microsoft Office dar şi articole legate de sistemul de operare Microsoft Windows.Pe Alexandru îl găsiţi şi pe ITSpark, Windows fără limite şi MicrosoftFeed unde activează ca Technical writer. Vezi toate articolele scrise de Alexandru Dionisie →Scrie un comentariu: Click here to cancel reply.Nume (Obligatoriu)
E-Mail (Obligatoriu - NU va fi afişat celorlalţi)
Site
XHTML: Poţi folosi următoarele tag-uri: : Trimite comentariu ! Anunţă-mă prin E-mail daca apar comentarii noi.
Traducerea acestei pagini
Oferit de Microsoft® Translator Cele mai accesate:Configurarea contului de Yahoo Mail în Microsoft OutlookActivare MS Office 2010 PRO PLUS SubscriptionModificarea ribbon-ului din Office 2007 şi 2010 folosind cod XMLCum inserez o pagină cu orientare Landscape între două pagini cu orientare Portrait ?Cum instalez Microsoft Office 2010 ?Personal
RecomandăriAjutor ITIonas2IT SecurityMarian PC – Numai tutorialeMatran-Dan FlorinMihai BaboiPC Tuneup Blogprofu.infoPrograme pentru începătoriRomanian GeekŞcoala WebTutoriale WindowsWindows On Board © 2011 Tutoriale Office. Toate drepturile rezervate de Cosmin Tataru, proprietar site si domeniu si Alexandru Dionisie, autor colaborator. XHTML / CSS Valid.
View the Original article
Niciun comentariu:
Trimiteți un comentariu