Import Web copier occurrences multiples [Résolu]

Signaler
Messages postés
34
Date d'inscription
mercredi 14 juin 2017
Statut
Membre
Dernière intervention
17 avril 2021
-
Messages postés
34
Date d'inscription
mercredi 14 juin 2017
Statut
Membre
Dernière intervention
17 avril 2021
-
Hello la Team,

Je cherche à récupérer automatiquement des liens de livres en provenance des ces pages :
https://www.decitre.fr/livres/loisirs-nature-voyages/recits-de-voyage.html

J'ai donc créé un classeur à 2 feuilles : EXPORT avec en colonne A la pagination et en colonne B le "réceptacle" des liens, et une feuille TEMP pour récupérer les données de l'URL appelée.
Cette petite macro ne fonctionne qu'à moitié, dans le sens où dès qu'elle trouve un lien, elle passe à la PAGE suivante, sans se préoccuper des liens qui suivent :

Sub IMPORTURLDECITRE()
Dim ISBN As String
Derlig = Sheets("EXPORT").Range("A" & Rows.Count).End(xlUp).Row
For compteur = 2 To Derlig
PAGE = Sheets("EXPORT").Cells(compteur, 1)
Sheets("TEMP").Cells.Clear
Application.CutCopyMode = False
With Sheets("TEMP").QueryTables.Add(Connection:="URL;https://www.decitre.fr/livres/loisirs-nature-voyages/recits-de-voyage.html?p=" & PAGE _
, Destination:=Sheets("TEMP").Range("$A$1"))
.Name = PAGE
.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
Derlig2 = Sheets("TEMP").Range("A" & Rows.Count).End(xlUp).Row
With Sheets("TEMP")
For compteur2 = 2 To Derlig2
Set Col_A = .Range("A2:A" & .Range("A" & Rows.Count).End(xlUp).Row)
URL = Application.CountIf(Col_A, "*Commander Ajouter au panier Ajouter à ma liste*")
If URL > 0 Then
Lig = 1
Lig = .Columns("A").Find("Commander Ajouter au panier Ajouter à ma liste", .Cells(Lig, "A"), , xlPart).Row

Sheets("EXPORT").Cells(compteur, 2) = Sheets("TEMP").Cells(Lig + 1, 1).Hyperlinks(1).Address
Sheets("EXPORT").Cells(compteur, 2).Interior.ColorIndex = 4
Else
Sheets("EXPORT").Cells(compteur, 2) = "inconnu"
Sheets("EXPORT").Cells(compteur, 2).Interior.ColorIndex = 3
End If
End With
Next
Next
End Sub


Où ai-je pêché ?
Et, cerise sur le gâteau, récupérer le 1er livre de chaque page, qui n'a pas en Lig-1 le repère "Commander Ajouter au panier Ajouter à ma liste"

Merci d'avance,

LeGhe

6 réponses

Messages postés
15565
Date d'inscription
lundi 9 juin 2008
Statut
Contributeur
Dernière intervention
10 mai 2021
849
bonjour,
en testant comme je pouvais ton code, je me demande si ton analyse est correcte.
tu écris "dès qu'elle trouve un lien, elle passe à la PAGE suivante, sans se préoccuper des liens qui suivent"
je pense que la macro fait autre chose: chaque fois qu'elle trouve un lien, elle le copie vers le réceptacle prévu, sur la ligne correspondant à la page, en écrasant, bien sûr, le(s) lien(s) éventuellement sauvé(s) précédemment.
Messages postés
15565
Date d'inscription
lundi 9 juin 2008
Statut
Contributeur
Dernière intervention
10 mai 2021
849
en fait, c'est pire que cela:
ta boucle avec compteur2 fait exactement la même chose à chaque itération, comme tu n'y utilises pas compteur 2 ni ne fait rien qui "progresse" dans les données.
c'est, donc, en effet, le premier lien qui est recopié à chaque fois.

ce code est donc sérieusement défectueux.

le moment me semble donc venu de partager un fichier avec en TEMP les données récupérées du site, et en EXPORT un exemple parlant du résultat attendu.
Messages postés
34
Date d'inscription
mercredi 14 juin 2017
Statut
Membre
Dernière intervention
17 avril 2021

Bonjour, et merci.
La macro doit récupérer 6074 URL sur 304 pages.
Donc colonne A de 1 à 304, et colonne B au final de 1 à 6074.
L'exemple joint ne prend en compte que la 1ère URL de chaque page en "passant au-dessus" des 19 autres (à partir de la ligne 365 de la feuille TEMP)

https://www.cjoint.com/c/KDrjAKgaZip
Messages postés
15565
Date d'inscription
lundi 9 juin 2008
Statut
Contributeur
Dernière intervention
10 mai 2021
849
je pense que ceci fonctionnera mieux:
Option Explicit

Sub IMPORTURLDECITRE()
Dim ISBN As String
Dim Derlig, compteur, Derlig2, compteur2, Page, Col_A, URL, Lig, ligdest As Long
Derlig = Sheets("EXPORT").Range("A" & Rows.Count).End(xlUp).Row
ligdest = 2
For compteur = 2 To Derlig
      Page = Sheets("EXPORT").Cells(compteur, 1)
      Sheets("TEMP").Cells.Clear
      Application.CutCopyMode = False
      With Sheets("TEMP").QueryTables.Add(Connection:="URL;https://www.decitre.fr/livres/loisirs-nature-voyages/recits-de-voyage.html?p=" & Page _
          , Destination:=Sheets("TEMP").Range("$A$1"))
          .Name = Page
          .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
    Derlig2 = Sheets("TEMP").Range("A" & Rows.Count).End(xlUp).Row
    For compteur2 = 2 To Derlig2
        If Sheets("TEMP").Cells(compteur2, 1) = "Commander Ajouter au panier Ajouter à ma liste" Then
            Sheets("EXPORT").Cells(ligdest, 2) = Sheets("TEMP").Cells(compteur2 + 1, 1).Hyperlinks(1).Address
            Sheets("EXPORT").Cells(ligdest, 2).Interior.ColorIndex = 4
            ligdest = ligdest + 1
        End If
    Next compteur2
Next compteur
End Sub
Messages postés
34
Date d'inscription
mercredi 14 juin 2017
Statut
Membre
Dernière intervention
17 avril 2021

Merci infiniment, je comprends mieux mon erreur !

cela dit il y a une erreur d'execution 9 : l'indice n'appartient pas à la selection lors du changement de page :

Sheets("EXPORT").Cells(ligdest, 2) = Sheets("TEMP").Cells(compteur2 + 1, 1).Hyperlinks(1).Address
Messages postés
15565
Date d'inscription
lundi 9 juin 2008
Statut
Contributeur
Dernière intervention
10 mai 2021
849
examine la valeur de compteur2 au moment de l'erreur, et regarde ce que contient la cellule à la ligne suivante.
Messages postés
34
Date d'inscription
mercredi 14 juin 2017
Statut
Membre
Dernière intervention
17 avril 2021

compteur 2 = 749
ligne suivante : Commander Ajouter au panier Ajouter à ma liste
MAIS sans hyperlink dessous car dernier de la page
Messages postés
15565
Date d'inscription
lundi 9 juin 2008
Statut
Contributeur
Dernière intervention
10 mai 2021
849
que contient la ligne sans hyperlink?
que faut-il faire dans ce cas-là?
Messages postés
15565
Date d'inscription
lundi 9 juin 2008
Statut
Contributeur
Dernière intervention
10 mai 2021
849 >
Messages postés
15565
Date d'inscription
lundi 9 juin 2008
Statut
Contributeur
Dernière intervention
10 mai 2021

peut-être suffit-il d'ajouter
-1
en fin de ligne 36.
Messages postés
34
Date d'inscription
mercredi 14 juin 2017
Statut
Membre
Dernière intervention
17 avril 2021

La ligne sans hyperlink est "Trier par".
Le -1 ne fonctionne pas.
Comment lui faire comprendre de stopper quand il trouve le DEUXIEME "Trier par" ?
Messages postés
15565
Date d'inscription
lundi 9 juin 2008
Statut
Contributeur
Dernière intervention
10 mai 2021
849
ne suffit-il pas alors de tester si un hyperlien est présent?
    For compteur2 = 2 To Derlig2
        If Sheets("TEMP").Cells(compteur2, 1) = "Commander Ajouter au panier Ajouter à ma liste" Then
            If Sheets("TEMP").Cells(compteur2 + 1, 1).Hyperlinks.Count > 0 Then
                Sheets("EXPORT").Cells(ligdest, 2) = Sheets("TEMP").Cells(compteur2 + 1, 1).Hyperlinks(1).Address
                Sheets("EXPORT").Cells(ligdest, 2).Interior.ColorIndex = 4
                ligdest = ligdest + 1
            End If
        End If
    Next compteur2
Messages postés
34
Date d'inscription
mercredi 14 juin 2017
Statut
Membre
Dernière intervention
17 avril 2021

Vous êtes formidable ! Grand merci...