Titre du sujet : Re: procédure pour récupérer données web
par myDearFriend! le 08/05/2010 15:21:47
Bonjour bassatine, le Forum,
Tu dis avoir des connaissances informatiques très limitées aussi je doute qu'en te donnant simplement quelques indications (aussi opérationnelles soient-elles), tu puisses te débrouiller... Ou alors, tu es un génie qui s'ignore 
Je vais donc essayer de te mettre sur la voie et peut-être te donner envie d'approfondir le sujet car tu verras, Excel et VBA ça peut être passionnant aussi...
Dans la pièce jointe, tu trouveras donc peut-être une réponse à ta demande.
Après avoir ouvert le classeur en activant les macros, tu cliques sur le bouton "Mise à jour" et tu patientes quelques secondes...
Bien sûr, on peut faire plus court et on peut certainement faire plus rapide, mais j'ai préféré privilégier la solution la plus abordable pour toi il m'a semblé.
Tout d'abord, l'outil de base pour développer avec VBA dans Excel, s'appelle l'"enregistreur de macro" (pour plus d'infos et faire connaissance avec cet outil, je te conseille la consultation de CE LIEN).
En utilisant donc l'enregistreur de macro, je suis parti de ta procédure manuelle et l'ai suivie comme tu le fais. A terme, j'ai obtenu le code VBA suivant :
Sub Macro1()
'
' Macro1 Macro
' Macro enregistrée le 07/05/2010 par myDearFriend!
'
'
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;http://www2.france-galop.com/fgweb/Do ... m=297&statut=DP" _
, Destination:=Range("A1"))
.Name = _
"cheval_perf.aspx?navigationChevaux=true&idcheval=03153823&aaCrse=2010&cSp=P&numCrsePgm=297&statut=DP_2"
.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 = xlWebFormattingAll
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
End Sub
Je suis donc parti de ce code extrait de l'enregistreur et j'ai ensuite "brodé" un peu avec mes connaissances VBA (je ne suis pas un spécialiste Requête Web cela dit !). Par ailleurs, pour ce type de procédure, il convient aussi d'avoir quelques notions HTML : en premier lieu, j'ai décortiqué un peu le code HTML de ta page web pour repérer les seules balises "Table" sur lesquelles m'intéresser. C'est de là par exemple que j'en tire les noms comme "ctl00$cphContenuCentral$navigation_cheval$ddlChevaux" qui peuvent paraitre un peu barbare à première vue... Mais c'est tout bonnement le nom qu'a choisi le concepteur de cette page Web.
Dans le classeur joint, j'ai utilisé le code complet ci-après :
Option Explicit
'myDearFriend! - www.mdf-xlpages.com
Sub Traitement()
Dim vURL As String
'URL de départ (à adapter au besoin)
vURL = "http://www2.france-galop.com/fgweb/Do ... m=297&statut=DP"
RecupChevaux vURL
End Sub
Sub RecupChevaux(vURL As String)
Dim IE As InternetExplorer
Dim sel As HTMLSelectElement
Dim TabChevaux() As String
Dim L As Long
Dim i As Byte
'OBJECTIF : Récupérer les éléments de la liste déroulante chevaux (n° de Ref du cheval + Nom du cheval) dans un tableau String
Application.ScreenUpdating = False
'on ouvre la page web dans IE de façon invisible
Set IE = CreateObject("internetExplorer.Application")
IE.Visible = False
IE.Navigate vURL
Do Until IE.ReadyState = READYSTATE_COMPLETE
DoEvents
Loop
'On stocke les éléments (N° + Nom) dans le tableau de type String redimensionné
Set sel = IE.Document.getElementById("ctl00$cphContenuCentral$navigation_cheval$ddlChevaux")
For i = 0 To sel.Length - 1
ReDim Preserve TabChevaux(1 To 2, 1 To i + 1)
TabChevaux(1, i + 1) = sel(i).Value
TabChevaux(2, i + 1) = sel(i).getAdjacentText("afterBegin")
Next i
'On ferme IE (devenu inutile)
IE.Quit
Application.ScreenUpdating = True
'OBJECTIF : On récupère les tableaux Carrière de chaque cheval de la liste dans l'onglet Résultats
With Sheets("www.mdf-xlpages.com")
'On efface d'abord les anciennes données de l'onglet Résultats
.Cells.Delete
Application.ScreenUpdating = False
'On boucle sur la liste de chevaux stockée pour récupérer les données souhaitées
For i = 1 To UBound(TabChevaux, 2)
'Trouver la prochaine ligne libre de l'onglet Résultats
L = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
'On inscrit le Nom du cheval
.Cells(L + 2, 1).Value = TabChevaux(2, i)
'On récupère le tableau de carrière (par requête Web)
RecupCarriere .Cells(L + 4, 1), TabChevaux(1, i)
Next i
Application.ScreenUpdating = True
End With
MsgBox "Traitement terminé ! ", vbInformation + vbOKOnly, "myDearFriend! - www.mdf-xlpages.com"
End Sub
Sub RecupCarriere(R As Range, Ncheval As String)
Dim vURL As String
vURL = "http://www2.france-galop.com/fgweb/Do ... =true&idcheval="
vURL = vURL & Ncheval
vURL = vURL & "&aaCrse=2010&cSp=P&numCrsePgm=297&statut=DP"
With R.Parent.QueryTables.Add(Connection:= _
"URL;" & vURL, Destination:=R)
.Name = "MaRequete"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlSpecifiedTables
.WebTables = "ctl00_cphContenuCentral_gvCarriere" 'ici, on cible uniquement la table souhaitée
.WebFormatting = xlWebFormattingAll
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
.Delete
End With
End Sub
Je ne vais pas pouvoir t'expliquer en détail toute ma démarche, mais tu trouveras en couleur verte des commentaires que j'ai laissé pour que tu puisses te situer un peu dans ce code.
En espérant t'avoir un peu dépanné...
Cordialement,
|
Didier FOURGEOT