Import donnée web

Version imprimable

Import donnée web

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:

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:

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

11/10/2018, 10h47
vbcoc

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).

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:

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

15/10/2018, 10h50
vbcoc

Merci beaucoup, c'est niquel,
J'adapte et te fais un retour asap,
Encore merci !!!
05/08/2019, 11h15
vbcoc

bouteille à la mer
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:

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
05/08/2019, 17h53
patricktoulon

1 pièce(s) jointe(s)

re

bonjour vdoc
ben oui la page a changé de structure
je te met le doigt dessus
Pièce jointe 495595
tu devrais t'en sortir
essaie de le faire c'est pas grand chose a changer

Encore un grand merci pour ta réponse,
malheureusement en changeant le code par :

Code:

1
2
3
4
5
6
7
8
9
10
        For Each elem In .document.all
            If elem.classname = "sc-bdVaJa sc-bwzfXH dvtCVZ" 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

cela boucle encore au premier for.
désolé je suis débutant en langage html.
Bien à toi

12/08/2019, 18h06
vbcoc

bouteille à la mer

Rebonjour,
Après quelques recherche je crois que la class est crypté.
C'est pour cela que ça ne fonctionne pas.
pouvez vous me le confirmer s'il vous plait ? Que je ne cherche plus pour rien
Bien à vous,
Vbcoc
19/08/2019, 10h28
vbcoc

petite relance

Bonjour,
Qui a une idée svp ? Je bloque,
Merci encore