Extraction de données de pages web

Version imprimable

Voir 40 message(s) de cette discussion en une page

Bonjour,

Dans le cadre de recherches que je mène, je souhaiterais extraire les dons faits une plateforme de crowdfunding.Ex: http://www.kisskissbankbank.com/fr/p...s/contributors

J'ai déjà fait le code suivant et il fonctionne :)
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 Sub step3() On Error Resume Next Dim IE As New InternetExplorer Dim News As String Dim Comments As String Dim Contributors As String Dim Follower As String Dim i As Integer Dim t As Integer t = 1 i = 0 For i = 0 To 87 IE.Visible = False IE.navigate "http://www.kisskissbankbank.com/fr/projects/bigdream/contributors" Do DoEvents Loop Until IE.readyState = READYSTATE_COMPLETE Dim Doc As HTMLDocument Set Doc = IE.document Cells(t, 2) = Doc.getElementsByClassName("user-thumb")(i).getElementsByClassName("amount")(0).innerText t = t + 1 Next End Sub
Le problème est que lorsqu'il y a plus de 50 donateurs. Il y a un bouton "en voir plus" et là je ne sais pas comment faire pour aller chercher les dons qui se cachent derrière ce bouton.

Pouvez-vous m'aider?

Bonne journée,

Thomas

31/03/2016, 11h38
Marc-L

Bonjour, bonjour !

Après avoir cliquer sur « En voir plus » regarder donc l'adresse de la nouvelle page web !

Voilà, voilà !

Edit : la deuxième fois je n'ai plus vu l'adresse se modifier ! Ce n'est pas grave,
il suffit avec l'outil d'inspection du navigateur de regarder l'adresse de la page appelée (page 2) …
Ou même sans via le menu contextuel Copier l'adresse du lien puis la coller pour la découvrir !

______________________________________________________________________________________________________
Je suis Paris, Charlie, Bruxelles, …
31/03/2016, 11h52
leclercqth

Merci pour votre retour.

Malheureusement, le lien URL reste le même.

Bonne journée,
Thomas
31/03/2016, 11h54
Marc-L

Citation:

Envoyé par Marc-L

Edit : la deuxième fois je n'ai plus vu l'adresse se modifier ! Ce n'est pas grave,
il suffit avec l'outil d'inspection du navigateur de regarder l'adresse de la page appelée (page 2) …

:fleche: Ou même sans via le menu contextuel Copier l'adresse du lien puis la coller pour la découvrir !
31/03/2016, 12h00
leclercqth

J'ai copié-collé en changeant le numéro de la page (page 2 par ex). Ceci fonctionne-t-il pour vous? car je tombe sur la même page avec comme dernier donateur Voisin75 qui est le même que sur la page 1.

Merci pour vos idées et conseils :-)
31/03/2016, 12h06
Marc-L

Exact ! Désolé ! :(

Les p'tits malins, via l'outil d'inspection d'un navigateur on peut voir un évènement associé,
il faut donc simuler le click ! Je vais voir de ce côté là …
31/03/2016, 12h07
cerede2000

Arf !
C'est du dynamique sur le principe d'infinite-list donc même si tu appel

Citation:

http://www.kisskissbankbank.com/fr/p...ibutors?page=2

Ça t'ouvre la page avec la liste sans charger le reste....

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Sub Demo()
        Dim Elt As Object
    With CreateObject("InternetExplorer.Application")
            .Navigate "http://www.kisskissbankbank.com/fr/projects/les-succulentes/contributors"
            .Visible = True
            While .Busy Or .ReadyState < 4:  DoEvents:  Wend
        For Each Elt In .Document.all("project-contributors").getElementsByTagName("A")
              If Elt.innerText = "En voir plus" Then
                 Elt.Click
             Set Elt = Nothing
                 Exit For
              End If
        Next
    End With
End Sub

Comme le lien est le dernier élément :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
Sub Demo2()
    With CreateObject("InternetExplorer.Application")
            .Navigate "http://www.kisskissbankbank.com/fr/projects/les-succulentes/contributors"
            .Visible = True
            While .Busy Or .ReadyState < 4:  DoEvents:  Wend
        With .Document.all("project-contributors").getElementsByTagName("A")
            With .Item(.Length - 1)
              If .innerText = "En voir plus" Then .Click
            End With
        End With
    End With
End Sub

______________________________________________________________________________________________________

Merci de cliquer sur :plusser: pour chaque message ayant aidé puis sur :resolu: pour clore cette discussion …

31/03/2016, 19h49
leclercqth

Merci beaucoup. Ca marche !!!! :ptdr::ptdr:

Je vais essayer maintenant assayer de faire que la macro clique à chaque fois qu'elle voit le "voir plus" car il se peut qu'il y ai plusieurs pages.

Merci beaucoup pour votre aide.
31/03/2016, 20h00
Marc-L

Bon courage !

Citation:

Envoyé par leclercqth

J'ai déjà fait le code suivant et il fonctionne

Non, ton code ne fonctionne pas rien qu'en voyant la ligne On Error Resume Next au début du code
et totalement inutile en phase de développement ! Vérifié après l'avoir testé sans et, avec, les montants sont faux !
Cela explique aussi l'extrême lenteur de cette procédure tellement il y a d'erreurs …

Sinon au lieu de détecter la présence de « En voir plus » une autre voie est de comparer
le nombre total de contributeurs (information présente dès la page initiale) avec le nombre de lignes lues …

en fait
il faut tester la présence de ce bouton "en savoir plus " si c'est le cas
refaire la requête avec la même adresse suivie de "?page=2"

attention cependant il s'avère que l'on tombe sur les même données alors tester la table avec la précédente pour ne pas avoir de doublons tout simplement parce que arriver a 50

Le JS créé une autre div en invisible pour la suite sauf que 50 n'est pas 51 donc on a une page vide combler bien évidement par les 50 premiers

voila

sinon si on manipule le bouton ? alors
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 Sub test() Dim IE, URL, elem, mestr(2) As Object URL = "http://www.kisskissbankbank.com/fr/projects/les-succulentes/contributors" Set IE = CreateObject("internetexplorer.application") IE.Visible = True IE.navigate URL Do: DoEvents: Loop While IE.readystate <> 4 Or IE.busy With IE.document For Each elem In .all If elem.tagname = "A" And elem.classname = "load-more-contributors" Then elem.Click Next Do: I = I + 1: Loop While I < 10000 'un petit ralentisseur les marqueurs de points d'arrete (readystate et busy) ne fonctionne pas comme beaucoup de pages web actuelles Set matable1 = .getelementsbytagname("table")(0) Set matable2 = .getelementsbytagname("TABLE")(1) Set mestr(1) = matable1.getelementsbytagname("TR") Set mestr(2) = matable2.getelementsbytagname("TR") MsgBox matable1.innerhtml MsgBox matable2.innerhtml 'dans les msgbox tu a le code des 2 tables tu saura faire le reste?????? '.quit End With End Sub
;)

re
et finalement pour faire plus pro qu'une boucle do loop sur i
on fera

Code:

Do: Loop While .getelementsbytagname("table").Length < 2

voila

31/03/2016, 21h15
patricktoulon

re
@cerede2000!!!

Citation:

Envoyé par cerede2000

Arf !
C'est du dynamique sur le principe d'infinite-list donc même si tu appel

Ça t'ouvre la page avec la liste sans charger le reste....

faux je viens de m'en apercevoir car tant que rel<>"next" ca ne fonctionne pas dans le JS regarde bien le rel a quel moment il se met a next et les data sont a true
;)

on est donc bien obligé de manipuler le bouton
sinon exécuter plusieurs script avec document .excescript la fonction 1puis 2 puis 3 mais c'est tordu comme ca et les boucles d'attentes sont encore plus complexes
31/03/2016, 21h54
cerede2000

Oui c'est ce que j'avais remarquer....
Un principe d'infinite-liste mais qui requiert de cliquer sur en voir plus...

Du coup pas facile de tout récupéré d'un coup, une boucle tant que en voir plus est présent ?

Et du coup c'est un faux simulateur de page avec la variable get qui ne sert en fait a rien....

Patrick, il peut y avoir plus de deux tables ! Exemple BigDream …

Citation:

Envoyé par Marc-L

Sinon au lieu de détecter la présence de « En voir plus » une autre voie est de comparer
le nombre total de contributeurs (information présente dès la page initiale) avec le nombre de lignes lues …

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
Sub Demo3()
              Dim L&, N&, T&, oRow As Object
              Cells(2).CurrentRegion.Clear
              Cells(2).Value = "   Extraction en cours …"
    With CreateObject("InternetExplorer.Application")
             .Navigate "http://www.kisskissbankbank.com/fr/projects/les-succulentes/contributors"
              While .Busy Or .ReadyState < 4:  DoEvents:  Wend
        With .Document.all("project-contributors")
                N = .getElementsByTagName("LI")(3).all(0).all(0).innerText
                ReDim VA(1 To N, 1 To 2)
            Do
                With .getElementsByTagName("TABLE")
                        While .Length = T:  DoEvents:  Wend
                    For Each oRow In .Item(T).Rows
                        With oRow.Cells
                                                       L = L + 1
                                                VA(L, 1) = .Item(1).all(0).innerText
                            If .Length > 3 Then VA(L, 2) = Val(.Item(3).innerText)
                        End With
                    Next
                End With
                If L < N Then
                    With .getElementsByTagName("A")
                         .Item(.Length - 1).Click
                    End With
                          T = T + 1
                End If
            Loop While L < N
        End With
            .Quit
    End With
    With [B1:C1].Resize(N)
        .Value = VA
        .Columns(1).AutoFit
    End With
End Sub

______________________________________________________________________________________________________

Merci de cliquer sur :plusser: pour chaque message ayant aidé puis sur :resolu: pour clore cette discussion …

01/04/2016, 00h08
patricktoulon

re

salut marc

oui c'est une base après on peu dans un do loop boucler jusqu'à que le bouton is nothing en récupérant le code html de la table

ensuite transfert illico dans le clipboard d'un htmlfile et paste sur le sheets

bref des solutions il y a

mis a part ca tu sais pourquoi ces sites ne sont pas en France
par ce qu'en France c'est illégal et il sont dans le collimateur de la répression des fraudes

j'ai lu un article la dessus je vais essayer de le retrouver car en effet les projets estimé a plus de 10000 euros voient rarement le jour sauf quelques actions humanitaires alors l'argent travaille et ne rapporte rien a la France et les contributeurs sont finalement laisés car il ne touchent aucun intérêt seulement leur mises de départ par contre qui touche les intérêt de cet argent qui est placé dans une banque pendant des mois en attendant hein????!!!!!

dans l'article il parlais aussi des actions binaires mais bon c'est pas le sujet

ca demande réflexion en tout cas
a bon entendeur ;)

Ptite suggestion pour récupérer le nombre de donations :

Code:

.Document.getElementsByClassName("bankers")(0).InnerText

Au cas ou il décide un jour de rajouter un LI en plus.... :)

Edit : @Patricktoulon :
Genre ça :

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
Sub Demo3()
    Dim L&, N&, T&, oRow As Object
    Cells(2).CurrentRegion.Clear
    Cells(2).Value = "   Extraction en cours …"
    With CreateObject("InternetExplorer.Application")
        .Navigate "http://www.kisskissbankbank.com/fr/projects/les-succulentes/contributors"
 
        While .Busy Or .ReadyState < 4:  DoEvents:  Wend
 
        N = .Document.getElementsByClassName("bankers")(0).innerText
 
        ReDim VA(1 To N, 1 To 2)
 
        With .Document.getElementsByClassName("load-more-contributors")
            While Not .Item(0) Is Nothing
                .Item(0).Click
            Wend
        End With
 
        With .Document.getElementById("project-contributors").getElementsByTagName("TABLE")
            Debug.Print .Item(T).Rows.Length
            For Each oRow In .Item(T).Rows
                With oRow.Cells
                    L = L + 1
                    VA(L, 1) = .Item(1).Children(0).innerText
                    If .Length > 3 Then VA(L, 2) = Val(.Item(3).innerText)
                End With
            Next
        End With
 
        .Quit
    End With
    With [B1:C1].Resize(N)
        .Value = VA
        .Columns(1).AutoFit
    End With
End Sub

Bizarrement ça ne fonctionne pas....
Le Rows.Length renvoi 50.....

Edit 2 : Trouvé, en fait il rajoute une table plutôt que d'ajouter les lignes a la table existante......

Je vais pas encore agrandir mon post précédent alors :)

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
Sub Demo3()
    Dim L&, N&, T&, oRow As Object
    Cells(2).CurrentRegion.Clear
    Cells(2).Value = "   Extraction en cours …"
    With CreateObject("InternetExplorer.Application")
        .Navigate "http://www.kisskissbankbank.com/fr/projects/les-succulentes/contributors"
 
        While .Busy Or .ReadyState < 4:  DoEvents:  Wend
 
        N = .Document.getElementsByClassName("bankers")(0).innerText
 
        ReDim VA(1 To N, 1 To 2)
 
        With .Document.getElementsByClassName("load-more-contributors")
            While Not .Item(0) Is Nothing
                .Item(0).Click
            Wend
        End With
 
        With .Document.getElementById("project-contributors")
            For Each oTable In .getElementsByTagName("TABLE")
                For Each oRow In oTable.Rows
                    With oRow.Cells
                        L = L + 1
                        VA(L, 1) = .Item(1).Children(0).innerText
                        If .Length > 3 Then VA(L, 2) = Val(.Item(3).innerText)
                    End With
                Next
            Next
        End With
        .Quit
    End With
    With [B1:C1].Resize(N)
        .Value = VA
        .Columns(1).AutoFit
    End With
End Sub

Reste une intérogation comment attendre que la page soit fini d'être rafraîchi car ceci :

Code:

1
2
3
4
5
        With .Document.getElementsByClassName("load-more-contributors")
            While Not .Item(0) Is Nothing
                .Item(0).Click
            Wend
        End With

En mode debug pas à pas j'attends un peu et c'est bon, mais en exécution normal ça va trop vite du coup erreur....

Edit : Ceci semble ok :)

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
39
40
41
Sub Demo3()
    Dim L&, N&, T&, oIE, oTable, oRow As Object
    Cells(2).CurrentRegion.Clear
    Cells(2).Value = "   Extraction en cours …"
    Set oIE = CreateObject("InternetExplorer.Application")
    With oIE
        .Navigate "http://www.kisskissbankbank.com/fr/projects/les-succulentes/contributors"
 
        While .Busy Or .ReadyState < 4:  DoEvents:  Wend
 
        With .document.getElementsByClassName("load-more-contributors")
            While Not .Item(0) Is Nothing
                .Item(0).Click
                While oIE.Busy Or oIE.ReadyState < 4:  DoEvents:  Wend
            Wend
        End With
 
        N = .document.getElementsByClassName("bankers")(0).innerText
        ReDim VA(1 To N, 1 To 2)
 
        With .document.getElementById("project-contributors")
            For Each oTable In .getElementsByTagName("TABLE")
                For Each oRow In oTable.Rows
                    With oRow.Cells
                        L = L + 1
                        VA(L, 1) = .Item(1).Children(0).innerText
                        If .Length > 3 Then VA(L, 2) = Val(.Item(3).innerText)
                    End With
                Next
            Next
        End With
        .Quit
    End With
 
    Set oIE = Nothing
 
    With [B1:C1].Resize(N)
        .Value = VA
        .Columns(1).AutoFit
    End With
End Sub

Code:

1
2
3
4
5
6
With .Document.getElementsByClassName("load-more-contributors")
            While Not .Item(0) Is Nothing
                .Item(0).Click
                While oIE.Busy Or oIE.ReadyState < 4:  DoEvents:  Wend
            Wend
        End With

01/04/2016, 10h47
patricktoulon

re

Bonjour cerede2000

en fait sur beaucoup de page web aujourd'hui les point d'arrêt (readystate et busy) fonctionne mal

depuis marc et moi avons trouvé diverses astuces pour gérer ca
en l'occurrence ici c'est simple

tu a ta page avec x tables tu lance la nouvelle page comment pourrait on détecter la fin du chargement a ton avis

regarde le post #11

Oui en effet dommage ça oblige aussi à compter le nombre de fois que l'on clic :)

Code:

1
2
3
4
5
6
7
8
With .document.getElementsByClassName("load-more-contributors")
            C = 1
            While Not .Item(0) Is Nothing
                .Item(0).Click
                C = C + 1
                While oIE.document.getElementById("project-contributors").getelementsbytagname("TABLE").Length < C: Wend
            Wend
        End With

01/04/2016, 11h16
Marc-L

Citation:

Envoyé par cerede2000

Ptite suggestion pour récupérer le nombre de donations :

Code:

.Document.getElementsByClassName("bankers")(0).InnerText

Oui sauf que selon les versions d'IE et de Windows parfois cela ne fonctionne pas bien …

Citation:

Envoyé par cerede2000

Le Rows.Length renvoi 50.....

Edit 2 : Trouvé, en fait il rajoute une table plutôt que d'ajouter les lignes a la table existante......

Oui comme déjà géré par mon code du post #14 !

Citation:

Envoyé par cerede2000

Reste une intérogation comment attendre que la page soit fini d'être rafraîchi
En mode debug pas à pas j'attends un peu et c'est bon, mais en exécution normal ça va trop vite du coup erreur....

Là aussi voir mon code du post #14 : détection de la nouvelle table …

Voir 40 message(s) de cette discussion en une page