Tourner page IE en VBA

Version imprimable

Bonjour,

J'ai une macro qui permet notamment de récupérer les données d'un site internet.

Pour l'exemple on va prendre un site connu celui de "leboncoin".

Or j'arrive très bien à récupérer les données de la première page.

En revanche, je ne sais pas récupérer celles des feuilles suivantes.

Je pensais faire une boucle sur les pages mais je sais pas si cela est possible. Si vous avez une méthode approprié?? Peut-être avec un clic sur page suivante.

Pour info le code qui récupère la première page du site.
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 42 43 44 Sub extraction() On Error GoTo sortie: Dim url As String: url = "https://www.leboncoin.fr/voitures/offres/provence_alpes_cote_d_azur/?th=1&q=swift" Dim element As Object, souselement As Object Dim IEDoc As HTMLDocument Dim IE As New InternetExplorer IE.navigate url IE.Visible = True Do While IE.readyState <> READYSTATE_COMPLETE DoEvents Loop Set IEDoc = IE.document Set element = IEDoc.getElementsByClassName("tabsContent").Item(0) Dim numLigne As Integer, numColonne As Integer For numLigne = 0 To element.Children.Length - 1 Debug.Print numLigne Set souselement = element.Children.Item(numLigne) For numColonne = 0 To souselement.Children.Length - 1 Cells(numLigne + 1, numColonne + 1).Value = souselement.Children.Item(numColonne).innerText Next numColonne Next numLigne 'libération de la mémoire Set IEDoc = Nothing IE.Quit Set IE = Nothing MsgBox "Import web terminé sans erreur" Exit Sub sortie: Set IEDoc = Nothing IE.Quit Set IE = Nothing MsgBox "Erreur. Vérifiez votre connexion à Internet" End Sub
En vous remerciant par avance.

Bonne journée

Bonjour,

en fait il n'y a pas de méthode unique, tout dépend de la structure de la page Web …
Le code suivant fonctionne pour ton exemple sur le Bon Coin mais pas pour d'autres sites !
Et j'ai même rencontré le cas au sein d'un même site utiliser différentes méthodes selon la page …

Quelles sont les versions d'IE et de Windows ? Merci.

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 ExtractionPages()
    Const URL = "https://www.leboncoin.fr/voitures/offres/provence_alpes_cote_d_azur/?th=1&q=swift"
    Dim element As Object, souselement As Object
    Dim IEDoc As HTMLDocument, IE As New InternetExplorer
    Dim numLigne As Integer, numColonne As Integer
 
    ActiveSheet.UsedRange.Clear
    Application.ScreenUpdating = False
    On Error GoTo sortie
 
    IE.navigate URL
    IE.Visible = True
    While IE.readyState <> READYSTATE_COMPLETE:  DoEvents:  Wend
 
    Do
           Set IEDoc = IE.Document
         Set element = IEDoc.getElementsByClassName("tabsContent").Item(0)
 
        For numLigne = 0 To element.Children.Length - 1
                Set souselement = element.Children.Item(numLigne)
            For numColonne = 0 To souselement.Children.Length - 1
                T$ = souselement.Children.Item(numColonne).innerText
                If T > "" Then R& = R& + 1: Cells(R, 1).Value = T
            Next numColonne
        Next numLigne
 
        With IEDoc.getElementById("next")
         If .className = "element page static" Then .Click Else Exit Do
        End With
        While IE.Document.readyState <> "complete":  DoEvents:  Wend
    Loop
         T = "OK"
sortie:
'   libération de la mémoire
    Set IEDoc = Nothing
    IE.Quit
    Set IE = Nothing
    Cells(1).CurrentRegion.WrapText = False
    Application.ScreenUpdating = True
    MsgBox IIf(T = "OK", "Import web terminé sans erreur", "Erreur. Vérifiez votre connexion à Internet")
End Sub

_________________________________________________________________________________________________________

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

@PatrickToulon & @davido84 :

si vous passez ici, merci de me dire si le code initial ou même le mien fonctionne de votre côté sans rien modifier,
il y a juste les références à activer …

_________________________________________________________________________________________________________

Je suis Paris, Charlie, Bruxelles, …

06/07/2016, 18h33
davido84

Marc : ton code fonctionne correctement sur Windows10+IE11 à partir du moment où une temporisation est prévue avant (ou éventuellement après) le click (358 lignes renvoyées). Sinon il s'arrête avant ("Erreur. Vérifiez votre connexion à Internet") vers 72 lignes.
A+
06/07/2016, 20h15
Marc-L

Pourtant la ligne de code n°30 attend la mise à jour de la page suivante après le click !
Et 347 lignes importées …

Je vous ai posé la question car le code initial fonctionnait déjà sans modification de mon côté …
06/07/2016, 20h44
davido84

Effectivement mais sans la temporisation la procédure est souvent stoppée avant la fin (environ une fois sur deux)...

bonsoir
normalement toutes les pages

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
42
43
44
45
46
47
48
49
Sub extraction()
 
On Error GoTo sortie:
Dim url As String: url = "https://www.leboncoin.fr/voitures/offres/provence_alpes_cote_d_azur/?th=1&q=swift"
Dim element As Object, souselement As Object, i As Long, nb As Object, nbpage As Long
 
Dim IEDoc As HTMLDocument
Dim IE As New InternetExplorer
 
IE.Visible = True
 i = 1
 Do
 
 IE.navigate url
Do While IE.readyState <> READYSTATE_COMPLETE
    DoEvents
Loop
 
Set IEDoc = IE.document
Set element = IEDoc.getElementsByClassName("tabsContent").Item(0)
 If nbpage = 0 Then
 Set nb = IEDoc.getElementsByClassName("tabsSwitchNumbers")(0)
nbpage = Round(Val(nb.innerText) / 35)
End If
Dim numLigne As Integer, numColonne As Integer
 
For numLigne = 0 To element.Children.Length - 1
    Debug.Print numLigne
    derlig = Cells(Rows.Count, 1).End(xlUp).Row
    Set souselement = element.Children.Item(numLigne)
    For numColonne = 0 To souselement.Children.Length - 1
        Cells(derlig + 1, numColonne + 1).Value = Replace(souselement.Children.Item(numColonne).innerText, vbCrLf, "")
    Next numColonne
Next numLigne
 url = "https://www.leboncoin.fr/voitures/offres/provence_alpes_cote_d_azur/?o=" & i & "&q=swift"
 i = i + 1
 Loop Until i = nbpage
'libération de la mémoire
Set IEDoc = Nothing
IE.Quit
Set IE = Nothing
MsgBox "Import web terminé sans erreur"
Exit Sub
 
sortie:
Set IEDoc = Nothing
IE.Quit
Set IE = Nothing
MsgBox "Erreur. Vérifiez votre connexion à

@Patrick : toutes les données ne sont pas ramenées.

Ci-joint une proposition sur ton idée. Les données sont ramenées en ligne et utilisation d'une fonction RegExp pour rechercher le nombre de pages à traiter.
A finaliser bien entendu :

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
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
Sub extraction2() 
On Error GoTo sortie:
Dim url As String
Dim element As Object
Dim souselement As Object
Dim numLigne As Integer
Dim IEDoc As HTMLDocument
Dim LienPage As Object
Dim IE As New InternetExplorer
Dim CettePage As Long, NumElement As Long, nbpage As Long, NbItem As Long ',nb As Object
 
ActiveSheet.UsedRange.Clear
Application.ScreenUpdating = False
url = "https://www.leboncoin.fr/voitures/offres/provence_alpes_cote_d_azur/?th=1&q=swift"
IE.Visible = True
 
 NbItem = 1
 
 Do
 
    IE.navigate url
    Do While IE.readyState <> READYSTATE_COMPLETE
        DoEvents
    Loop
 
    Set IEDoc = IE.document
    Set element = IEDoc.getElementsByClassName("tabsContent").Item(0)
    Set LienPage = IEDoc.getElementsByClassName("pagination_links_container")
    nbpage = PageMax(LienPage.Item(0).innerText)
 
'    If nbpage = 0 Then
'      Set nb = IEDoc.getElementsByClassName("tabsSwitchNumbers")(0)
'      nbpage = Round(Val(nb.innerText) / 35)
'    End If
 
    For numLigne = 0 To element.Children.Length - 1
        Set souselement = element.Children.Item(numLigne)
        For NumElement = 0 To souselement.Children.Length - 1
            Cells(NbItem, 1).Value = souselement.Children.Item(NumElement).innerText
            NbItem = NbItem + 1
        Next NumElement
    Next numLigne
 
     CettePage = CettePage + 1
     url = "https://www.leboncoin.fr/voitures/offres/provence_alpes_cote_d_azur/?o=" & CettePage & "&q=swift"
 Loop Until CettePage = nbpage + 1
 
  ActiveSheet.UsedRange.WrapText = False
  Application.ScreenUpdating = True
 
'libération de la mémoire
Set IEDoc = Nothing
IE.Quit
Set IE = Nothing
MsgBox "Import web terminé sans erreur"
Exit Sub
sortie:
Set IEDoc = Nothing
IE.Quit
Set IE = Nothing
MsgBox "Erreur. Vérifiez votre connexion à"
Application.ScreenUpdating = True
End Sub
 
 
Function PageMax(T As String) As Long
Dim oReg As Object, oMatches As Object
Set oReg = CreateObject("vbscript.regexp")
 
With oReg
  .Global = True
  .Pattern = "\d+"
  If .test(T) Then
    Set oMatches = .Execute(T)
    PageMax = oMatches.Count
  End If
End With
 
End Function

A+

07/07/2016, 13h13
patricktoulon

re

Bonjour davido
c'est sensiblement la même chose mais de toute façon mon idée globale n'est pas bonne

le fait de se servir de l'url modifié comme le fait la page web après click est faussé par anti robot
en effet si tu regarde bien des fois on a la même page

je me suis battu pendant des plombes mais c'est impossible et le pire c'est que ca le fait pas tout le temps et le moment( selon l'index de page )est aléatoire

d'autant plus que ce site a même une protection contre l'outil de développement (F12) qui fonctionne 1 coup sur 3 ,une vraie saloperie ce truc

purée les outil IE VB ,VBA sont vraiment a la ramasse
et ca va pas aller en s'améliorant puisque maintenant le navigateur c'est edge

il est donc raisonnable de penser (l'espoir fait vivre) que l'on pourra très prochainement manipuler EDGE comme pour IE dans sa fast-période

sinon bientôt on pourra plus faire ce que l'on fait

EDIT:
essaie juste pour voir

Code:

set myNav=createobject("EDGE.application")

:ptdr:
07/07/2016, 13h18
Marc-L

De toute manière, il était question de supprimer le VBA ! :ptdr:

Sinon Patrick, tu n'as pas répondu à ma question du post #2 …
07/07/2016, 13h28
nonesofar

Bonjour, merci à tous pour votre aide,

Ben le code posté à 01h41 de patricktoulon marche plutôt pas mal chez moi!! :D

En fait je voulais savoir, si possible quelle type de méthode vous avez utilisé?

Clic sur la page suivante ou avec URL?

Désolé mais pas expert sur le sujet :).

Citation:

De toute manière, il était question de supprimer le VBA

Oh non je commençais à bien gérer en vba :(
07/07/2016, 18h52
patricktoulon

re
oaouais bientôt on codera dans un c#editor :ptdr::ptdr:

et oui ton essai ca marche visiblement

EDIT:
et oui marc tu a raison d'observer les multiclassname je l'avais zappé
Code:

1 2 3 With IEDoc.getElementById("next") If .className = "element page static" Then .Click Else Exit Do End Wit
une de ces classe doit changer a la fin je pense
08/07/2016, 10h00
nonesofar

Hello,

Oue en tout cas vos propositions sont au top merci pour votre expertise.

En plus je sais que le site le bon coin est pas facile à gérer, ils bloquent pas mal l'extraction de donnée.

J'espére que VBA aura encore une longue vie :D.

Bonne journée à tous.
08/07/2016, 12h46
Marc-L

Je n'ai jamais eu de blocage avec ce site et il fait parti des plus faciles !
08/07/2016, 14h37
nonesofar
Hello Marc L,

Sur la difficulté du site, je me permettais juste de rebondir sur ce que patricktoulon disait, comme j'expliquais c'est ma première expérience avec ce site.

Citation:

le fait de se servir de l'url modifié comme le fait la page web après click est faussé par anti robot
en effet si tu regarde bien des fois on a la même page

je me suis battu pendant des plombes mais c'est impossible et le pire c'est que ca le fait pas tout le temps et le moment( selon l'index de page )est aléatoire

Juste une petite amélioration, si je veux que l'utilisateur copie l'url dans une imputbox.
Code:

1 2 3 Dim urlrecherche As String urlrecherche = InputBox("Saisie de votre Recherche : ")
Comment ne pas dégrader le lien si on fait avec une variable au lieu du lien

Code:

"https://www.leboncoin.fr/voitures/offres/provence_alpes_cote_d_azur/?o=" & CettePage & "&q=swift"

C'est une petite amélioration que je souhaite faire :D

Bonne journée.

bonjour

Code:

1
2
3
4
5
 
 Dim artrecherche As variant
 artrecherche  = InputBox("Saisissez  l'article recherché de votre Recherche  : ")
cettepage=1
url="https://www.leboncoin.fr/voitures/offres/provence_alpes_cote_d_azur/?o=" & CettePage & "&q="& artrecherche

11/07/2016, 09h57
nonesofar

Bonjour à tous,

Un grand merci @patricktoulon, @Marc-L, @davido84 pour leur aide.

Tout fonctionne, sujet résolu.

Bonne journée. 8-):D