Import donnée web

**vbcoc** · 09/10/2018, 14h35

Bonjour,

Dans le cadre d'un projet personnel,
J'essaye d'importer des données du site https://www.premierleague.com sur une table excel.

Deux étapes me bloquent pour avancer.

I - extraction sur certaines pages et pas toutes.

Visiblement sur certaine pageweb mon code fonctionne :
- https://www.premierleague.com/stats/.../goals?se=210/

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
Sub importer()
 
    Sheets("Feuil1").Cells.Clear
 
    With Sheets("Feuil1").QueryTables.Add(Connection:="URL;https://www.premierleague.com/stats/top/players/goals?se=210/" _
        , Destination:=Sheets("Feuil1").Range("$A$1"))
        .Name = "www.blog-excel"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = False
        .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
 
    compteur = 0
 
End Sub

---------------------------------------------------------------------------------
En revanche, sur d'autres pages, cela ne fonctionne pas :

https://fantasy.premierleague.com/a/...s/total_points

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
Sub importer()
 
    Sheets("feuil1").Cells.Clear
 
    With Sheets("feuil1").QueryTables.Add(Connection:="URL;https://fantasy.premierleague.com/a/statistics/total_points" _
        , Destination:=Sheets("feuil1").Range("$A$1"))
        .Name = "www.blog-excel"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = False
        .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
 
    compteur = 0
 
End Sub

II - sélectionner les pages du tableau
Toujours sur la même pageweb (https://fantasy.premierleague.com/a/...s/total_points),
je souhaite extraire les données de tout le tableau.

Merci d'avance pour vos réponses,

Vbcoc

**vbcoc** · 11/10/2018, 10h47

Bonjour,
Je me permets de vous relancer.
Pour information, le premier lien ne fonctionne pas finalement (il donne un autre résultat que la pageweb en question).

**patricktoulon** · 11/10/2018, 13h49

bonjour avec une requete object ou querytable tu peux pas il y a plusieurs pages et elles se pilotent dans l'explorateur
exemple complet pour ce lien (https://fantasy.premierleague.com/a/...s/total_points)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
Sub test()
    Dim url, Ie As Object, page$, table, elem As Object, bouton_next As Object, shap As Shape, i&, a&
    url = "https://fantasy.premierleague.com/a/statistics/total_points"
    ActiveSheet.Cells.Clear
    Application.ScreenUpdating = False
    With CreateObject("internetexplorer.application")
        .Visible = True
        .navigate url
        Do: DoEvents: Loop While .readystate <> 4
re:
        For Each elem In .document.all
            If elem.classname = "ism-pagination__info" Then page = Trim(Split(elem.innertext, "of")(1))
        Next
        If page = "" Then GoTo re
        For i = 1 To Val(page) - 1
            Set table = .document.getelementsbytagname("TABLE")
            code = code & table(0).outerhtml
            For Each elem In .document.all
                If elem.classname = "paginationBtn ismjs-change-page ism-pagination__button" Then Set bouton_next = elem
            Next
            bouton_next.Click
            Do: DoEvents: Loop While .readystate <> 4 Or .busy
        Next
        With CreateObject("htmlfile")
            .body.innerhtml = code
            .parentwindow.clipboarddata.SetData "text", code
        End With
        .Quit
    End With
    'on colle le tout dans le sheet
    With ActiveSheet
        .Cells(1).Select: .Paste
        For Each shap In .Shapes
            shap.Delete
        Next
        .Columns("A:A").Delete Shift:=xlToLeft
    End With
End Sub

**vbcoc** · 15/10/2018, 10h50

Merci beaucoup, c'est niquel,
J'adapte et te fais un retour asap,
Encore merci !!!

**vbcoc** · 05/08/2019, 11h15

Bonjour à toutes et à tous,
Petite bouteille à la mer,
Je relance le sujet car le programme ne fonctionne plus...
Je pense que c'est par ce que la page web est spécifique en début de saison.
Quelqu'un peut m'aider s'il vous plait ?

Pour reprendre le code de Patricktoulon que je remercie encore, je bug ici :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
For Each elem In .document.all
    If elem.classname = "ism-pagination__info" Then page = Trim(Split(elem.innertext, "of")(1))
Next

j'ai l'impression qu'il ne trouve pas "ism-pagination__info" et donc que le code tourne tout le temp

je rappelle que le lien est ici : https://fantasy.premierleague.com/statistics et que je veux récuperer les différents champs.

D'avance merci,

Vbcoc