Rechercher des cours avec Excel (Securibourse)

par isee , lundi 18 décembre 2017, 13:04 (il y a 2535 jours) @ PBourdon

Bonjour

Ci-joint une solution VBA que j'ai enrichi "à ma sauce"... en espérant que ça puisse t'être utile.

Source des données pour la mise à jour= Boursorama

code à insérer dans un module VBA

Dim r As Long
Dim c As Long
Dim lig As Long
Dim i As Integer

Option Explicit

Sub Refresh_Boursorama()

'' !!!
''Outils > Références > Activer
''Microsoft HTML Object Library
''Microsoft XML, v6.0

Dim mXML As MSXML2.XMLHTTP60
Set mXML = New MSXML2.XMLHTTP60
Dim oDoc As MSHTML.HTMLDocument
Set oDoc = New HTMLDocument
Dim Element As IHTMLElement
Dim Elements As IHTMLElementCollection

'affectation des variables
i = 2
lig = ActiveSheet.Range("a65536").End(xlUp).Row

'nettoyage de la zone avant mise à jour
Range("b2:g" & lig).ClearContents

With mXML
For r = i To lig
.Open "GET", "http://www.boursorama.com/cours.phtml?symbole=" & Cells(r, 1).Value, False
.setRequestHeader "DNT", "1"
.send
If .Status = 200 Then
oDoc.body.innerHTML = .responseText

With oDoc.getElementsByTagName("TABLE")(0).Rows
Cells(r, "b").Value = ExtraitNombre(.Item(0).Cells(1).innerText) 'Cours
Cells(r, "c").Value = VBA.Replace(ExtraitNombre(.Item(3).Cells(1).innerText), " ", "") 'volume
Cells(r, "d").Value = .Item(1).Cells(1).innerText 'variation
Cells(r, "e").Value = .Item(2).Cells(1).innerText 'Dernier échange
Cells(r, "f").Value = .Item(8).Cells(1).innerText 'capital échangé
Cells(r, "g").Value = VBA.Replace(.Item(9).Cells(1).innerText, " MEUR", "") 'valo.
End With

End If
Next


End With

Set oDoc = Nothing
Set mXML = Nothing

MsgBox "Mise à jour terminée", vbOKOnly + vbInformation, "Message..."

End Sub

Function ExtraitNombre(chaine)
Dim Reg As Object
Set Reg = CreateObject("VBScript.RegExp")
With Reg
.Global = True: .Pattern = "(.[a-z].).": .IgnoreCase = True
ExtraitNombre = Reg.Replace(chaine, "")
End With
End Function

la feuille Excel en question > en image >>