Récupération cours sur boursorama (Securibourse)

par launay @, jeudi 07 mars 2019, 20:05 (il y a 1849 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

Avatar

Récupération cours sur boursorama

par jmp ⌂ @, Boulogne/Mer, jeudi 07 mars 2019, 21:57 (il y a 1848 jours) @ launay

Bonsoir,

Je n'ai pas remarqué de modifications dans la page renvoyée par boursorama: le programme de relevé des cours pour le jeu The Bull fonctionne toujours. Mais d'un autre côté, boursorama modifie régulièrement ses pages donc je ne vois pas bien comment vous pourrez vous en sortir sans connaître un minimum de programmation. Celui qui a écrit ce programme est le mieux placé pour l'adapter à une modification de la page donc la première chose à faire est de le contacter.

--
jean-marie

Avatar

Récupération cours sur boursorama

par isee @, vendredi 08 mars 2019, 09:22 (il y a 1848 jours) @ jmp

Bonjour

J'ai un programme (excel-vba) qui va aussi chercher les datas sur bourso et pas de problème observé.

par contre pour m'affranchir des modifs éventuelles sur bourso, ce qui ne garantie rien, je remonte le tout dans une feuille et après je fais des recherches (via vba) dans la feuille pour remonter les infos voulues dans une autre feuille

mon code pour remonter les infos dans une feuille appelée "ShTemp"

(la variable valeur peut être 1rPLOCAL (pour la valeur Solocal)


Dim r&
Dim c&
Dim lig
Dim i, ii, iii As Integer
Dim valeur As String
Dim ShTemp As Worksheets
'Dim cel, zone As Range

Option Explicit
____________________________________________________________

Sub Boursorama()

If Cells(r, 1) <> "1rPCAC" Then
valeur = "URL;https://www.boursorama.com/cours/" & valeur
Else
valeur = "URL;https://www.boursorama.com/bourse/indices/cours/2zPCS90" 'CAC SMALL"
End If

Sheets("ShTemp").Activate
Cells.Delete Shift:=xlUp
With Sheets("ShTemp").QueryTables.Add(Connection:=valeur, Destination:=Range("$A$1"))
.Name = valeur
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlEntirePage
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.refresh BackgroundQuery:=False
End With
End Sub

Récupération cours sur boursorama

par launay @, samedi 09 mars 2019, 08:20 (il y a 1847 jours) @ isee

Bonjour
Merci pour votre réponse , je vais la tester dans mon fichier.
Bon week-end

Récupération cours sur boursorama

par R2D2, dimanche 17 mars 2019, 20:17 (il y a 1839 jours) @ launay

En complément de ce qui a été dit, voici un lien sur le moyen de récupérer des infos sur internet via VBA sur Excel

http://jacxl.free.fr/cours_xl/cadres.html?ex=

Aller dans le menu du haut : XL+HTML
Puis dans le menu de gauche : "Chercher des informations sur une page Web (VBA)"

Fil RSS du sujet
powered by my little forum