Import Web copier occurrences multiples

Résolu
Leghe59 Messages postés 34 Date d'inscription   Statut Membre Dernière intervention   -  
Leghe59 Messages postés 34 Date d'inscription   Statut Membre Dernière intervention   -
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
A voir également:

6 réponses

Réponse 1 / 6
yg_be Messages postés 23541 Date d'inscription   Statut Contributeur Dernière intervention   Ambassadeur 1 584
 
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.
0
yg_be Messages postés 23541 Date d'inscription   Statut Contributeur Dernière intervention   1 584
 
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.
0
Réponse 2 / 6
Leghe59 Messages postés 34 Date d'inscription   Statut Membre Dernière intervention  
 
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
0
yg_be Messages postés 23541 Date d'inscription   Statut Contributeur Dernière intervention   1 584
 
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
0
Réponse 3 / 6
Leghe59 Messages postés 34 Date d'inscription   Statut Membre Dernière intervention  
 
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
0
yg_be Messages postés 23541 Date d'inscription   Statut Contributeur Dernière intervention   1 584
 
examine la valeur de compteur2 au moment de l'erreur, et regarde ce que contient la cellule à la ligne suivante.
0
Réponse 4 / 6
Leghe59 Messages postés 34 Date d'inscription   Statut Membre Dernière intervention  
 
compteur 2 = 749
ligne suivante : Commander Ajouter au panier Ajouter à ma liste
MAIS sans hyperlink dessous car dernier de la page
0
yg_be Messages postés 23541 Date d'inscription   Statut Contributeur Dernière intervention   1 584
 
que contient la ligne sans hyperlink?
que faut-il faire dans ce cas-là?
0
yg_be Messages postés 23541 Date d'inscription   Statut Contributeur Dernière intervention   1 584 > yg_be Messages postés 23541 Date d'inscription   Statut Contributeur Dernière intervention  
 
peut-être suffit-il d'ajouter 
-1
en fin de ligne 36.
0

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
Réponse 5 / 6
Leghe59 Messages postés 34 Date d'inscription   Statut Membre Dernière intervention  
 
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" ?
0
yg_be Messages postés 23541 Date d'inscription   Statut Contributeur Dernière intervention   1 584
 
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
0
Réponse 6 / 6
Leghe59 Messages postés 34 Date d'inscription   Statut Membre Dernière intervention  
 
Vous êtes formidable ! Grand merci...
0

Discussions similaires

dessin avec symbole clavier
JSS -
Adraen -

79 réponses