Discussion :

[leclercqth]

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 :

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

[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, …

[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) …

Ou même sans via le menu contextuel Copier l'adresse du lien puis la coller pour la découvrir !

[leclercqth]

Merci pour votre retour.

Malheureusement, le lien URL reste le même.

Bonne journée,
Thomas

[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 :-)

[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à …

[Marc-L]

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
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 :

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

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 pour chaque message ayant aidé puis sur pour clore cette discussion …

[leclercqth]

Merci beaucoup. Ca marche !!!!

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.

[cerede2000]

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

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

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

[patricktoulon]

re
@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

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

[Marc-L]

Bon courage !

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 …

[patricktoulon]

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 :

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
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 :

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

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

voila

[Marc-L]

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

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 :

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
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 pour chaque message ayant aidé puis sur pour clore cette discussion …

[patricktoulon]

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

[cerede2000]

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

Code :

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

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

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

Edit : @Patricktoulon :
Genre ça :

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

[cerede2000]

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

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
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 :

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

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 :

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
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 :

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

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