Rapport de message :*
 

Re: Récupération archives sur le site zeturf.fr

Titre du sujet : Re: Récupération archives sur le site zeturf.fr
par myDearFriend! le 15/09/2010 20:28:04

Bonsoir jc24,

Eh bien, je pense avoir terminé mes tests et te livre les résultats de ma réflexion sur ton problème...

Mais AVANT DE TESTER le classeur en pièce jointe, et pour une bonne compréhension du fonctionnement, je te prie de lire les quelques lignes qui suivent :

J'ai tout d'abord travaillé à partir du classeur que je t'avais proposé dans ton fil précédent, classeur récupérant les cotes de chaque course hippique.

Je résume un peu la situation :
Dans un premier temps : le classeur récupère les données issues du site ZEturf.fr et stocke de façon journalière (un jour = un onglet) les côtes de chaque participant et pour chaque course.

Dans un deuxième temps, le lendemain (ou n'importe quel jour suivant), tu souhaites récupérer des données de Résultats et Rapports concernant ces mêmes courses. Sur le site de Turf, l'accès à ces données de rapports se fait via un calendrier dans lequel il convient de choisir la date souhaitée, puis la ou les courses cibles.

Après une courte analyse, il paraît évident que le cheminement via "Archives/Calendrier/Choix de la réunion/Choix de la course" pour récupération des données est plus que tortueux et favorise peu une procédure VBA adaptée en conséquence...

J'ai toutefois remarqué une chose intéressante :
Pour consulter (et récupérer !) les cotes d'une course sur le site Web, l'URL est sous cette forme :
http://www.zeturf.fr/fr/cotes/ suivi de 17780-SAINT-CLOUD/88430-Prix-de-Saint-Pair-du-Mont
Pour consulter ensuite les Résultats et Rapports correspondant, l'URL est cette fois la suivante :
http://www.zeturf.fr/fr/resultats/ suivi de 17780-SAINT-CLOUD/88430-Prix-de-Saint-Pair-du-Mont

... voilà une chose intéressante !

Ainsi, quand on possède l'URL qui a fourni les cotes, on en déduit très facilement l'URL qui servira à récupérer les Rapports !
Plus besoin de parcourir le calendrier, il suffit de stocker les URL visitées lors de la première étape pour pouvoir reconstituer les URL utiles pour la 2ème étape.

Dans le classeur joint :
La procédure de récupération des cotes est donc légèrement modifiée pour stocker également dans le tableau les URL en question (cf les zones de titre séparant les courses). On la lance toujours via le bouton BLEU dans l'onglet « Menu ».

Un autre module VBA est construit pour parcourir - quand il le faut - les dites URL reconstituées et récupérer les données de Rapports souhaitées. La procédure correspondante se lance via le bouton VERT du « Menu ».

A la première ouverture, quand tu cliqueras sur le bouton VERT, les données de Rapports de l'onglet « 14-09-2010 ® » seront récupérées. Bien évidemment, celles de l'onglet « 15-09-2010 ® » ne seront dispos qu'à partir de demain.

Fonctionnement :
Lors de la création automatique d'un onglet, il est nommé avec la date du jour suivi du tag "®" (signifiant : Résultats ou Rapport à Récupérer).
La procécure TraitementRapports() va parcourir les noms d'onglets et vérifier la présence de ce tag pour s'arrêter à chaque fois que nécessaire pour compléter les données de Rapports manquantes.

Le code utilisé pour ce nouveau traitement est le suivant :
Option Explicit
' myDearFriend!  -  www.mdf-xlpages.com

Sub TraitementRapports()
Dim F As Worksheet
Dim Plage As Range, R As Range
Dim Lien As String, D As String
Const vURL As String = "http://www.zeturf.fr/fr/resultats/"
    For Each F In Worksheets
        With F
           If Right(F.Name, 2) = " ®" Then
                'Si onglet <> aujourd'hui
                D = Replace(.Name, " ®", "")
                If DateValue(D) <> Date Then
                    'Préparer la feuille cible
                     .Activate
                    .Columns("K:T").Delete Shift:=xlToLeft
                    Application.ScreenUpdating = False
                    'Récup des données web
                    Set Plage = .Range(.Cells(4, 1), DernCell.Offset(-1, 0)).SpecialCells(xlCellTypeBlanks)
                    For Each R In Plage
                        Lien = R.Offset(0, 1).Text
                        If InStr(1, Lien, "/") > 0 Then
                            Application.StatusBar = Lien
                            Lien = vURL & Lien
                            RecupRapports Lien, R.Offset(-2, 10)
                        End If
                    Next R
                    'mise en forme
                    .Range("K:N,Q:Q,S:S").Delete Shift:=xlToLeft
                    .Columns("K:M").EntireColumn.AutoFit
                    .Range("A1").Select
                    'Renommer l'onglet (supprimer le tag '®')
                    .Name = D
                    Application.ScreenUpdating = True
               End If
           End If
        End With
    Next F
    Application.StatusBar = False
    Beep
End Sub

Sub RecupRapports(vURL As String, R As Range)
    With ActiveSheet.QueryTables.Add(Connection:="URL;" & vURL, Destination:=R)
        .Name = "LaRequete"
        .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 = "4"
        .WebFormatting = xlWebFormattingRTF
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
        .Delete
    End With
    'Efface l'entête
    R.Resize(3, 9).ClearContents
End Sub

En espérant que ce processus convienne et réponde à tes attentes...

ATTENTION toutefois : j'ai laissé l'onglet « 13-09-2010 » pour l'exemple, mais j'ai du supprimer une bonne partie de ces données d'origine pour pouvoir faire perdre un peu de poids au fichier et le poster en pièce jointe ici.

Cordialement,