Mise à jour de Données Bourse

Bonjour,

Bonjour,

Pouvez vous m'aider à résoudre mon problème de récupération des valeurs boursière provenant de Boursorama.

L'appui sur Mise à jour ne fonctionne pas

Merci d'avance pour votre aide

Sub MajCotations()
    Dim i As Integer, k As Integer, URL As String, COT() As Double
    k = Cells(Rows.Count, [REF].Column).End(xlUp).Row
    Range(Cells(2, [Cotation].Column), Cells(k, [Cotation].Column)).Clear

    Dim avant As String, apres As String
    avant = "</div><div class=""c-ticker__item c-ticker__item--value"">"
    apres = "<span class=""c-ticker__currency"">"

    On Error Resume Next
    For i = 2 To k
        DoEvents
        ReDim Preserve COT(1 To k)
        URL = Cells(i, [WWW].Column).Value
        Application.StatusBar = "Mise à jour des cotations en cours …"
        On Error Resume Next
        With CreateObject("MSXML2.XMLHTTP")
            .Open "GET", URL, False
            .Send
            If .Status = 200 Then
                COT(i) = CDbl(Split(Split(.responseText, avant)(1), apres)(0)) ' CDbl pour les décimales
            End If
        End With
        Application.StatusBar = False
        Cells(i, [Cotation].Column).Value = COT(i)
    Next i
End Sub
Function ChercheChaine(chaine, pattern)
  Set obj = CreateObject("vbscript.regexp")
  obj.pattern = pattern
  Set a = obj.Execute(chaine)
  If a.Count > 0 Then ChercheChaine = a(0) Else ChercheChaine = ""
End Function

Comment puis je vous envoyer le fichier?

Cordialement

C.M
Windows / Chrome 137.0.0.0