Discussion :

[nonesofar]

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 :

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

[Marc-L]

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 :

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

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

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

[davido84]

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

[patricktoulon]

bonsoir
normalement toutes les pages

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