Récupéré plusieurs partie de texte dans page web

Bonjour,

Sur cette page https://www.ebay.fr/sch/m.html?_ssn=bigdeals1983&_pgn=1 , je souhaiterai récupérer les numéro d'objet des annonce ( exemple Objet : 224041271045 ).

J'ai une macro qui me recupere les lien des pages, je souhaiterais l'adapté pour récupéré tous les numéro d'objet.

Sub liste()
Dim page As New HTMLDocument, lien As Object, lig As Long, url As String, invit As String, i%, depuis%, jusque%

Sheets("liens").Select
Range("A1").CurrentRegion.Offset(1, 0).ClearContents
lig = 2
With Sheets("parametres")
depuis = IIf(.Range("B2") = "", 1, .Range("C2"))
jusque = IIf(.Range("B2") = "", 1, .Range("D2"))
For i = depuis To jusque
    page.body.innerHTML = pageHTML(IIf(.Range("B2") = "", .Range("A2"), .Range("A2") & .Range("B2") & i))
    For Each lien In page.getElementsByTagName("a")
        url = lien.getAttribute("HREF")
        invit = lien.innerHTML
        'If url Like "*puzzle-*" And Not invit Like "<IMG*" Then
            Cells(lig, 1) = Replace(url, "about:/", "https://www.ebay.fr/")
            Cells(lig, 2) = invit
            lig = lig + 1
        'End If
    Next lien
    ' MsgBox "Page " & i & " chargée !"
Next
End With
MsgBox "Fin !"
End Sub

Function pageHTML(url As String) As String
    With CreateObject("WINHTTP.WinHTTPRequest.5.1")
        .Open "GET", url, False
         .send
        pageHTML = .responseText
    End With
End Function
17sitemap-ebay.xlsm (260.32 Ko)

Je n'ai pas pu récupérer en auto le nombre de pages, donc indique en haut à droite le nombre d ce que tu souhaites récupérer.

petite modif pour simplifier le liens trouvés

Option Explicit

Sub OnYVa()
Dim i%, sw As Worksheet

    ' effacement
    Range("A1").CurrentRegion.Offset(2, 0).ClearContents

    ' recherche des liens
    rechercheLiens Range("A2").Value, "/www.ebay.fr/itm", "xxx"
    MsgBox "fin de recherche des liens !"

End Sub

Sub rechercheLiens(site As String, parametre As String, sauf As String)
Dim lig As Long, page As New HTMLDocument, lien As Object, url As String, i%, url2 As String

For i = 1 To [nbpages]

    ' création de l'objet page avec comme contenu le site
    page.body.innerHTML = pageHTML(site & IIf(i > 1, "&_pgn=" & i, ""))

    ' recherche des liens contenant un mot-clé
    lig = Range("A" & Rows.Count).End(xlUp).Row + 1 ' 1ère ligne disponible
    For Each lien In page.getElementsByTagName("a")
        url = lien.getAttribute("href")
        If url Like "*" & parametre & "*" And Not url Like "*" & sauf & "*" Then
            url2 = Split(url, "?hash")(0)
            Range("A" & lig) = url2
            Range("B" & lig) = "'" & Split(url2, "/")(UBound(Split(url2, "/")))
            Range("C" & lig) = i
            lig = lig + 1
        End If
    Next lien

Next

End Sub

Function pageHTML(site As String) As String
    With CreateObject("WINHTTP.WinHTTPRequest.5.1")
        .Open "GET", site, False
        .send
        pageHTML = .responseText
    End With
End Function

Merci

Rechercher des sujets similaires à "recupere partie texte page web"