Rechercher sur Internet le cours d’une valeur

Les exemples présentés ci-dessous ne sont donnés qu'à titre indicatif.
Les pages trouvées sur le Web présentent en effet la particularité d'être très changeantes. Le code qui marche bien aujourd'hui risque de devoir être adapté demain.
Attention, les macros utilisent à titre d'exemple des données provenant de plusieurs sites financiers. Ces données restent la propriété de ces sites, veillez à ne les utiliser que pour vos besoins privés.


La macro utilise plusieurs fonctions API (InternetOpenA, InternetCloseHandle, InternetOpenUrlA, InternetReadFile) pour commander l'ouverture et la fermeture de sessions Internet et de pages Web et pour lire le contenu des pages (cliquez ici).

Plusieurs avantages à cette méthode par rapport à l'ouverture directe de la page sous Excel ou à la mise en oeuvre de requetes :
- la macro utilisant les API est plus rapide (pas besoin d'ouvrir un fichier Excel)
- elle est plus fiable (gestion plus facile des mauvaises connexions pour éviter des erreurs)
- elle est mieux adaptée à l'automatisation de la récupération de données à partir d'un grand nombre de pages Web.

Par contre elle est un peu plus lourde à programmer (déclaration des fonctions API, recherche plus laborieuse des données dans la page Web).


La première macro est basée sur l'utilisation de pages téléchargées sur le site d'Euronext / Bourse-de-Paris :
L'adresse
http://www.bourse-de-paris.fr/servlet/market8.ValueResult?xls=ok&search=12007&lang=fr
pointe vers une page (fichier texte) contenant un petit tableau dans lequel se trouve le dernier cours de Air Liquide (Sicovam 12007) :

CodeLibelléDernierVariationPremierHautBasVolume
012007AIR LIQUIDE128.6-3.6133134.9128392140

Notre macro va ouvrir une session Internet, ouvrir la page Web, en lire le contenu, puis aller y chercher le cours :

Public Declare Function OuvreInternet Lib "wininet" _
    Alias "InternetOpenA" (ByVal sAgent As String, ByVal lAccessType As Long, _
    ByVal sProxyName As String, ByVal sProxyBypass As String, ByVal lFlags As Long) As Long
Public Declare Function fermeInternet Lib "wininet" _
    Alias "InternetCloseHandle" (ByVal hInet As Long) As Integer
Public Declare Function Ouvrepage Lib "wininet" _
    Alias "InternetOpenUrlA" (ByVal hInternetSession As Long, ByVal lpszUrl As String, _
    ByVal lpszHeaders As String, ByVal dwHeadersLength As Long, ByVal dwFlags As Long, _
    ByVal dwContext As Long) As Long
Public Declare Function code_page Lib "wininet" _
    Alias "InternetReadFile" (ByVal hFile As Long, ByVal sBuffer As String, _
    ByVal lNumBytesToRead As Long, lNumberOfBytesRead As Long) As Integer

Function valo_Euronext(sicovam)
'renvoie le cours selon Euronext, ou bien "" si échec
Dim texte_code As String * 1024
sicovam = Right("00" & sicovam, 5)
page_à_lire = "http://www.bourse-de-paris.fr/servlet/market8.ValueResult?xls=ok&search=" & sicovam & "&lang=fr"
encr:
internet = 0
'boucle jusqu'à trouver une connexion internet
Do While internet = 0
internet = OuvreInternet("toto", 1, vbNullString, vbNullString, 0)
Application.Wait Now + 0.5 / 24 / 3600
Loop
URL = 0
URL = Ouvrepage(internet, page_à_lire, vbNullString, _
    ByVal 0&, &H80000000, ByVal 0&) 'ouvre la page Web
Application.Wait Now + 0.5 / 24 / 3600

'lit le texte de la page
code_page URL, texte_code, 1024, nb_caractères_lus
txtlu = Left(texte_code, nb_caractères_lus)

fermeInternet URL 'ferme la page
fermeInternet internet 'ferme Internet
'si la page n'est pas une page Euronext, recommencer
If InStr(txtlu, "Code") = 0 Then GoTo encr

valo_Euronext = ""
'rechercher le numéro de sicovam, puis les tab
If InStr(txtlu, sicovam) > 0 Then
txtlu = Right(txtlu, Len(txtlu) - InStr(txtlu, sicovam) - 1)
txtlu = Right(txtlu, Len(txtlu) - InStr(txtlu, Chr(9))) 'tab
txtlu = Right(txtlu, Len(txtlu) - InStr(txtlu, Chr(9))) 'tab
If txtlu <> "" Then txtlu = Left(txtlu, InStr(txtlu, Chr(9)) - 1)
If IsNumeric(txtlu) Then valo_Euronext = 1 * txtlu
End If

End Function


La fonction renvoie le dernier cours de la valeur dont le sicovam est en argument.
On peut ainsi écrire :    MsgBox valo_Euronext(12007).
Mais on peut aussi inscrire dans une page Excel :    =valo_Euronext(12007)

A titre de comparaison, la fonction suivante (beaucoup plus courte) est basée sur l'ouverture de la même page Web directement dans Excel.

Function cours_Euronext(sicovam)
cours_Euronext = ""
Application.ScreenUpdating = False
Workbooks.OpenText FileName:= _
"http://www.bourse-de-paris.fr/servlet/market8.ValueResult?xls=ok&search=" & _
sicovam & "&lang=fr" , DataType:=xlDelimited, Tab:=True
Set tr = Cells.Find("Dernier")
If Not tr Is Nothing Then tr = tr.Offset(1, 0)
If IsNumeric(tr) And tr <> "" Then cours_Euronext = 1 * tr
If InStr(ActiveWorkbook.FullName, "www.bourse-de-paris.fr") > 0 Then ActiveWorkbook.Close (False)
Application.ScreenUpdating = True
End Function



Le second exemple effectue la même opération à partir du site de Boursorama. Cette fois, la valeur est identifiée par son symbole et non par son code sicovam :
L'adresse http://www.boursorama.com/cours.phtml?symbole=1rPCA pointe vers une page html contenant de nombreuses informations sur le titre Carrefour.
Il faut en extraire la donnée qui nous intéresse (le dernier cours), ce qui peut être obtenu en recherchant le premier nombre suivant texte "Dernier" :

Public Declare Function OuvreInternet Lib "wininet" _
    Alias "InternetOpenA" (ByVal sAgent As String, ByVal lAccessType As Long, _
    ByVal sProxyName As String, ByVal sProxyBypass As String, ByVal lFlags As Long) As Long
Public Declare Function fermeInternet Lib "wininet" _
    Alias "InternetCloseHandle" (ByVal hInet As Long) As Integer
Public Declare Function Ouvrepage Lib "wininet" _
    Alias "InternetOpenUrlA" (ByVal hInternetSession As Long, ByVal lpszUrl As String, _
    ByVal lpszHeaders As String, ByVal dwHeadersLength As Long, ByVal dwFlags As Long, _
    ByVal dwContext As Long) As Long
Public Declare Function code_page Lib "wininet" _
    Alias "InternetReadFile" (ByVal hFile As Long, ByVal sBuffer As String, _
    ByVal lNumBytesToRead As Long, lNumberOfBytesRead As Long) As Integer

Function valo_Boursorama(cod)
'renvoie le cours selon B, ou bien "" si échec
Dim texte_code As String * 200
page_à_lire = "http://www.boursorama.com/cours.phtml?symbole=" & cod

encr:
internet = 0
'boucle jusqu'à trouver une connexion internet
Do While internet = 0
internet = OuvreInternet("toto", 1, vbNullString, vbNullString, 0)
Application.Wait Now + 0.5 / 24 / 3600
Loop
URL = 0
URL = Ouvrepage(internet, page_à_lire, vbNullString, _
    ByVal 0&, &H80000000, ByVal 0&) 'ouvre la page Web
Application.Wait Now + 0.5 / 24 / 3600

'lit le texte de la page jusqu'à trouver "dernier"
txtlu = ""
Do While InStr(txtlu, "<td>Dernier</td>") = 0 And InStr(txtlu, "</HTML>") = 0
code_page URL, texte_code, 200, nb_caractères_lus 'ajoute 200 caractères par sécurité
txtlu = txtlu & Left(texte_code, nb_caractères_lus)
If InStr(txtlu, "<HTML>") = 0 Then Exit Do
Loop
code_page URL, texte_code, 200, nb_caractères_lus
txtlu = txtlu & Left(texte_code, nb_caractères_lus)

fermeInternet URL 'ferme la page
fermeInternet internet 'ferme Internet

'si la page n'est pas une page B, recommencer
If InStr(Left(txtlu, 40), "Boursorama") <= 0 Then GoTo encr

valo_Boursorama = ""
'rechercher le nb qui est après "<td>Dernier</td>" et qui se termine par (c)
If InStr(txtlu, "<td>Dernier</td>") > 0 And InStr(txtlu, "(c)") > InStr(txtlu, "<td>Dernier</td>") Then
txtlu = Right(txtlu, Len(txtlu) - InStr(txtlu, "<td>Dernier</td>") - 16 + 1)
'chercher le premier nb
Do While Not IsNumeric(Left(txtlu, 1))
txtlu = Right(txtlu, Len(txtlu) - 1)
Loop
'chercher le cours de bourse
txtlu = Left(txtlu, InStr(txtlu, "(c)") - 1)
If IsNumeric(txtlu) Then valo_Boursorama = 1 * txtlu
End If
End Function



Le troisième exemple permet de récupérer un cours historique.
Comme le premier, il est basé sur le téléchargement de données à partir du site d'Euronext.
La page Euronext utilisée se présente sous forme d'un tableau :

DATE NOM SICOVAM DERNIER
02/01/97 AIR LIQUIDE 12007 96.95143
03/01/97 AIR LIQUIDE 12007 96.95143
06/01/97 AIR LIQUIDE 12007 99.41525
07/01/97 AIR LIQUIDE 12007 99.29206
08/01/97 AIR LIQUIDE 12007 101.87907
09/01/97 AIR LIQUIDE 12007 102.12545
10/01/97 AIR LIQUIDE 12007 101.13992
13/01/97 AIR LIQUIDE 12007 103.85013
14/01/97 AIR LIQUIDE 12007 104.95885
15/01/97 AIR LIQUIDE 12007 105.08204
16/01/97 AIR LIQUIDE 12007 105.94438
17/01/97 AIR LIQUIDE 12007 107.29948

Pour accéder à cette page, il faut connaitre le code Euronext correspondant au sicovam. On peut le trouver sur une autre page Web.
La fonction va, en deux étapes, récupérer pour un sicovam et une date donnés, la dernière date de cotation, le nom de la valeur et le cours :


Public Declare Function OuvreInternet Lib "wininet" _
    Alias "InternetOpenA" (ByVal sAgent As String, ByVal lAccessType As Long, _
    ByVal sProxyName As String, ByVal sProxyBypass As String, ByVal lFlags As Long) As Long
Public Declare Function fermeInternet Lib "wininet" _
    Alias "InternetCloseHandle" (ByVal hInet As Long) As Integer
Public Declare Function Ouvrepage Lib "wininet" _
    Alias "InternetOpenUrlA" (ByVal hInternetSession As Long, ByVal lpszUrl As String, _
    ByVal lpszHeaders As String, ByVal dwHeadersLength As Long, ByVal dwFlags As Long, _
    ByVal dwContext As Long) As Long
Public Declare Function code_page Lib "wininet" _
    Alias "InternetReadFile" (ByVal hFile As Long, ByVal sBuffer As String, _
    ByVal lNumBytesToRead As Long, lNumberOfBytesRead As Long) As Integer

Function hst_euronext(sicovam, dat)
Dim tabl(2)
'renvoie la date, le nom et le cours selon Euronext, ou bien "" si échec
'pas d'histo antérieur au 1/1/97
Dim texte_code As String * 1024
'recherche du code de la valeur
page_à_lire = _
"http://www.bourse-de-paris.fr/servlet/historique.action2?type=histo&jd=31&md=12&ad=1996&jf=24&mf=4&af=2004&search=" _
& sicovam & "&field=DERNIER&format=TXT"
encr:
internet = 0
'boucle jusqu'à trouver une connexion internet
Do While internet = 0
internet = OuvreInternet("toto", 1, vbNullString, vbNullString, 0)
Application.Wait Now + 0.5 / 24 / 3600
Loop
URL = 0
URL = Ouvrepage(internet, page_à_lire, vbNullString, _
    ByVal 0&, &H80000000, ByVal 0&) 'ouvre la page Web
Application.Wait Now + 0.5 / 24 / 3600

'lit le texte complet de la page
txtlu = ""
Do While InStr(txtlu, "</HTML>") = 0
code_page URL, texte_code, 1024, nb_caractères_lus
txtlu = txtlu & Left(texte_code, nb_caractères_lus)
Loop
fermeInternet URL 'ferme la page
fermeInternet internet 'ferme Internet

'si la page n'est pas une page Euronext, recommencer
hst_euronext = txtlu

If InStr(txtlu, "Euronext") = 0 Then GoTo encr

cod = ""
If InStr(txtlu, "name=""valeurs"" checked value=""") > 0 Then
txtlu = Right(txtlu, Len(txtlu) - InStr(txtlu, "name=""valeurs"" checked value=""") _
+ 1 - Len("name=""valeurs"" checked value="""))
Do While IsNumeric(Left(txtlu, 1)) Or Left(txtlu, 1) = "."
cod = cod & Left(txtlu, 1)
txtlu = Right(txtlu, Len(txtlu) - 1)
Loop
End If

page_à_lire = _
"http://www.bourse-de-paris.fr/servlet/historique.download?type=histo&jd=31&md=12&ad=1996&jf=24&mf=4&af=" & _
Year(Now) + 1 & "&valeurs=" & cod & "&field=DERNIER&format=TXT"
encr2:
internet = 0
'boucle jusqu'à trouver une connexion internet
Do While internet = 0
internet = OuvreInternet("toto", 1, vbNullString, vbNullString, 0)
Application.Wait Now + 0.5 / 24 / 3600
Loop
URL = 0
URL = Ouvrepage(internet, page_à_lire, vbNullString, _
    ByVal 0&, &H80000000, ByVal 0&) 'ouvre la page Web
Application.Wait Now + 0.5 / 24 / 3600

'lit le texte complet de la page
txtlu = ""
nb_caractères_lus = 1
Do While nb_caractères_lus <> 0
code_page URL, texte_code, 1024, nb_caractères_lus
txtlu = txtlu & Left(texte_code, nb_caractères_lus)
Loop
fermeInternet URL 'ferme la page
fermeInternet internet 'ferme Internet
'si la page n'est pas une page Euronext, recommencer
If InStr(txtlu, "SICOVAM") = 0 Then GoTo encr2
tabl(2) = ""

For derdat = Int(dat) - 5 To Int(dat)
If InStr(txtlu, Format(derdat, "dd/mm/yyyy")) > 0 Then
txtlu = Right(txtlu, Len(txtlu) - InStr(txtlu, Format(derdat, "dd/mm/yyyy")) + 1)
tabl(0) = derdat
End If
Next
If txtlu <> "" Then
txtlu = Right(txtlu, Len(txtlu) - InStr(txtlu, Chr(9))) 'tab
tabl(1) = Left(txtlu, InStr(txtlu, Chr(9)) - 1)
txtlu = Right(txtlu, Len(txtlu) - InStr(txtlu, Chr(9))) 'tab
txtlu = Right(txtlu, Len(txtlu) - InStr(txtlu, Chr(9))) 'tab
txtlu = Left(txtlu, InStr(txtlu, Chr(9)) - 1)
If IsNumeric(txtlu) Then tabl(2) = 1 * txtlu
End If
hst_euronext = tabl
End Function


La fonction renvoie un tableau comprenant la date, le nom et le cours. Il suffit d'écrire :
MsgBox hst_Euronext(12007, DateValue("24/04/2003"))(2)
pour connaitre le dernier cours d'Air Liquide au 24 avril 2003, et
MsgBox hst_Euronext(12007, DateValue("24/04/2003"))(0)
pour connaitre la date de la cotation.
De même, dans une page Excel, on peut écrire :
=INDEX(hst_euronext(12007;A1);3)
pour récupérer le cours ou bien
=INDEX(hst_euronext(12007;A1);2)
pour récupérer le nom (attention, en VBA, les éléments du tableau sont numérotés de 0 à 2, dans Excel de 1 à 3).