Récupération cours sur boursorama (Securibourse)

par launay , jeudi 07 mars 2019, 20:05 (il y a 2090 jours)

Bonjour
le code ci-dessous fonctionnait parfaitement avant le 5/03, date depuis laquelle le site Boursorama a changé la configuration de la page ou la macro récupérait les données pour les injecter dans une feuille Excel. Depuis le 5/03 je ne récupère aucune donnée. Ne connaissant pas la programmation des pages Web , je sollicite l'aide de celui qui pourrait adapter le code à la nouvelle configuration de la page de Boursorama
donnant les cours d'un titre (+ouverture, plus haut, plus bas, clôture et volume).
Par avance merci

Sub MesCotations()
'Téléchargement du cours de clôture sur le site Boursorama sur la base
'des liens Url inscrits colonne C
' 26/8/2018
Application.ScreenUpdating = False
Dim I%, K%, URL$, COT, RES
Dim Cold As Long, Start As Long
'Stockage des cours colonne 4
Cold = 5: Start = 2
K = Cells(Rows.Count, 1).End(xlUp).Row

ReDim RES(1 To K, 1 To 1)
'Raz de la colonne D
Range(Cells(Start, Cold), Cells(K, Cold)).ClearContents
'Définition des paramètres à charger
avant = "<div class=""c-faceplate__price""><span class=""c-instrument c-instrument--last"" data-ist-last>"
apres = "</span>"

On Error Resume Next
For I = 2 To K
DoEvents
ReDim COT(1 To K, 1 To 1)
COT(1, 1) = Cells(I, [Cotation].Column).Value
URL = Cells(I, [WWW].Column).Value
Application.StatusBar = "Mise à jour des cotations en cours …"
On Error Resume Next
'chargement des infos de la valeur concernée
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", URL, False
.Send
If .Status = 200 Then COT(I, 1) = Split(Split(.responseText, avant)(1), apres)(0)
'Remplissafe du tableau pour stockage
RES(I, 1) = Split(Split(.responseText, avant)(1), apres)(0)
End With
Application.StatusBar = False

Next
'Renvoi des cours obtenus vers la feuille
For I = LBound(RES) To UBound(RES)
Cells(I, Cold).Value = RES(I, 1)
Next
Erase RES: Erase COT
Range("D1").Formula = "Lien"
Range("E1").Formula = "New"

End Sub