Comment récupérer des liens web par le biais d'autres liens ?

[alpilon]

Bonjour,
voici mon problème, je cherche à récupérer tous les liens "courses?id" d'e plusieurs pages web, sauf que ces liens sont accessibles par le biais d'autres liens "reunions?id"

sachant qu'une réunion comporte plusieurs courses
comment faire pour récupérer directement tous les liens "courses?id" sur une page
voici ce que j'ai déjà bricolé avec des bouts de codes trouvés sur un site

Merci à vous

 

[porcinet82]

Re : Comment récupérer des liens web par le biais d'autres liens ?

Hello,

Je ne suis pas certains d'avoir tout pigé, mais essais de modifier la seconde partie de ton code avec celui-ci :

'TRAITEMENT Courses
Sheets("R1C1").Range("A:B").Clear


For i = 2 To Sheets("Recup").Range("B65536").End(xlUp).Row
    rURL = Sheets("Recup").Cells(i, 2).Value


    'Crée une instance d'IE invisible
    Set IE = CreateObject("internetExplorer.Application")
    IE.Visible = False
    'Ouvre la page Web
    IE.Navigate rURL
    Do Until IE.readyState = READYSTATE_COMPLETE
        DoEvents
    Loop
    'Récupère la liste de tous les ID intéressants (ID Courses sans doublon)
    Set IEDoc = IE.Document
    On Error Resume Next
    With Sheets("R1C1")
        Lign = .Range("B65536").End(xlUp).Row
        For L = 0 To IEDoc.Links.Length - 1
            Set IElien = IEDoc.Links(L)
            T = IElien
            If T Like "*course?id=*" Then
                If Val(IElien) < 1 Then
                    VerifL = Col.Count
                    Col.Add IElien, IElien      'Sans doublon
                    If VerifL <> Col.Count Then
                        Lign = Lign + 1
                        .Cells(Lign, 2).Value = IElien     'Nom de la course
                    End If
                End If
            End If
        Next L
    End With
    
    IE.Quit
Next
Application.ScreenUpdating = True

@+

 

[alpilon]

Re : Comment récupérer des liens web par le biais d'autres liens ?

Merci porcinet82

J'ai refais quelques corrections sur le code que tu m'a fourni et tout fonctionne parfaitement :

Sub MAJlisteRéunions()
Dim IE As InternetExplorer
Dim IEDoc As HTMLDocument
Dim IElien As HTMLLinkElement
Dim Col As New Collection
Dim T As String
Dim L As Long, VerifL As Long, Lign As Long
Dim i As Integer
Const rURL As String = [URL]http://www.lesitewebconceré.fr[/URL]
Dim cURL As String


 
   
    'TRAITEMENT Réunions
    
    Sheets("Recup").Range("A:B").ClearContents
    Application.ScreenUpdating = False
    'Crée une instance d'IE invisible
    Set IE = CreateObject("internetExplorer.Application")
    IE.Visible = False
    'Ouvre la page Web
    IE.Navigate rURL
    Do Until IE.readyState = READYSTATE_COMPLETE
        DoEvents
    Loop
    'Récupère la liste de tous les ID intéressants (ID Réunions sans doublon)
    Set IEDoc = IE.Document
    On Error Resume Next
    With Sheets("Recup")
        Lign = 1
        For L = 0 To IEDoc.Links.Length - 1
            Set IElien = IEDoc.Links(L)
            T = IElien
            If T Like "*reunion?id=*" Then
                If Val(IElien) < 1 Then
                    VerifL = Col.Count
                    Col.Add IElien, IElien      'Sans doublon
                    If VerifL <> Col.Count Then
                        Lign = Lign + 1
                        .Cells(Lign, 2).Value = IElien     'Nom de la réunion
                    End If
                End If
            End If
        Next L
        
    
    End With
    

    'TRAITEMENT Courses
 Sheets("R1C1").Range("A:B").Clear
 

For i = 2 To Sheets("Recup").Range("B65536").End(xlUp).Row
     cURL = Sheets("Recup").Cells(i, 2).Value
 

    'Crée une instance d'IE invisible
     Set IE = CreateObject("internetExplorer.Application")
     IE.Visible = False
     'Ouvre la page Web
     IE.Navigate cURL
     Do Until IE.readyState = READYSTATE_COMPLETE
         DoEvents
     Loop
     'Récupère la liste de tous les ID intéressants (ID Courses sans doublon)
     Set IEDoc = IE.Document
     On Error Resume Next
     With Sheets("R1C1")
         Lign = .Range("B65536").End(xlUp).Row
         For L = 0 To IEDoc.Links.Length - 1
             Set IElien = IEDoc.Links(L)
             T = IElien
             If T Like "*course?id=*" Then
                 If Val(IElien) < 1 Then
                     VerifL = Col.Count
                     Col.Add IElien, IElien      'Sans doublon
                     If VerifL <> Col.Count Then
                         Lign = Lign + 1
                         .Cells(Lign, 2).Value = IElien     'Nom de la course
                     End If
                 End If
             End If
         Next L
     End With
     
    IE.Quit
 Next
 Application.ScreenUpdating = True
End Sub

bon week a tous

 

[porcinet82]

Re : Comment récupérer des liens web par le biais d'autres liens ?

Hello,

Super, bon courage pour la suite !

@+