Extraction HTML

Bonjour à tous,

J'aime le nouveau design du site.

En fait, j'aimerai extraire les paragraphes et les titres d'un document web dans une seule colonne.

En debug.print ça marche mais quand j'assigne un FEUILLE Excel et cellule. Erreur 424 quant j'exécute le code.

Je cherche à ne pas extraire les textes entre la balise <p><em>... </p> dans la "class = listicle-page"

Et ne pas extraire le dernier paragraphe ou le dernier paragraphe <p><strong>... </p>.

(Je ne maitrise pas l'utilisation des "index" et bien d'autres sur le sujet )

Ci-dessous le code que j'ai essayé et un fichier test dans lequel j'ai mis les résultats voulus de l'extraction.

Private Sub ExtractionParagraphe()

    Dim oXMLPage As Object
    Dim aHTML As Object
    Dim sURL As String
    Dim i As Integer
    Dim j As Integer

    Dim div As Object
    Dim ptext As Object

    Set oXMLPage = CreateObject("MSXML2.ServerXMLHTTP")
    Set aHTML = CreateObject("htmlfile")

    sURL = "http://www.readersdigest.ca/health/conditions/6-ways-soothe-foot-pain/view-all/"

    oXMLPage.Open "GET", sURL, False
    oXMLPage.send

    aHTML.body.innerHTML = oXMLPage.responseText
    Set oXMLPage = Nothing

    Set div = aHTML.getElementsByTagName("div")

    For Each ptext In div
        If ptext.className = "listicle-page" Then
        i = 1
            For Each h In ptext.getElementsByTagName("h2")
                'Debug.Print h.innerText
            Sheets("Feuil1").Cells("A" & i + 1).Value = h(0).innerText

        j = 1
            For Each p In ptext.getElementsByTagName("p")
                'Debug.Print p.innerText
                Sheets("Feuil1").Cells("A" & j + 1).Value = p(0).innerText
              Next p
              i = i + 1
            Next h
        j = j + 1

        End If

    Next ptext

End Sub

Merci d'avance.

Cdt

28testhtml.xlsm (27.15 Ko)

Comme ceci :

            For Each h In ptext.getElementsByTagName("h2")
            Sheets("Feuil1").Range("A" & i + 1).Value = h.innerText

            j = 1
            For Each p In ptext.getElementsByTagName("p")
                Sheets("Feuil1").Range("A" & j + 1).Value = p.innerText
            Next p
            i = i + 1
            Next h

Merci mais ça n marche pas: erreur 5

Aucun soucis chez moi.

28testhtml.xlsm (24.71 Ko)

Chez moi, juste le dernier paragraphe que je ne veux pas extraire.

Chez moi, juste le dernier paragraphe que je ne veux pas extraire.

Je n'ai pas étudié l'extraction en elle-même, mais j'ai corrigé l'erreur 424.

Je m'excuse donc.

Je continue à creuser donc.

Merci!

Si tu as d'autres idées thebenoit59, je suis preneur.

Hello RSG et thebenoit59

Private Sub ExtractionParagraphe()

    Dim oXMLPage As Object
    Dim aHTML As HTMLDocument
    Dim sURL As String
    Dim i As Integer
    Dim j As Integer

    Dim articles As Object
    Dim article As Object

    Set oXMLPage = CreateObject("MSXML2.ServerXMLHTTP")
    Set aHTML = CreateObject("htmlfile")

    sURL = "http://www.readersdigest.ca/health/conditions/6-ways-soothe-foot-pain/view-all/"

    oXMLPage.Open "GET", sURL, False
    oXMLPage.send

    aHTML.body.innerHTML = oXMLPage.responseText
    Set oXMLPage = Nothing

    Set articles = aHTML.getElementsByClassName("listicle-page")
    i = 1
    For Each article In articles
        Sheets("Feuil1").Range("A" & i).Value = article.Children.Item(2).innerText
        Sheets("Feuil1").Range("A" & i + 1).Value = article.Children.Item(3).innerText
        i = i + 2
    Next article

End Sub

Je mets mon grain de sel si je peux me permettre : Range au lieu de Cells et sans (0)

.Range("A" & i + 1).Value = h.innerText
.Range("A" & j + 1).Value = p.innerText

edit : je n'avais pas vu la réponse de thebenoit59 ...


Par ailleurs, ton texte n'étant pas bien indenté on ne voit pas que les incréments sont mal placés :

    For Each ptext In div
        If ptext.className = "listicle-page" Then
            i = 1
            For Each h In ptext.getElementsByTagName("h2")
                Debug.Print h.innerText
                Sheets("Feuil1").Range("A" & (i + 1)).Value = h.innerText
                j = 1
                For Each p In ptext.getElementsByTagName("p")
                    Debug.Print p.innerText
                    Sheets("Feuil1").Range("A" & (j + 1)).Value = p.innerText
                    j = j + 1
                Next p
                i = i + 1
            Next h
        End If
    Next ptext

Voilà pour les corrections ... mais pourquoi faire une double recherche d'abord de div puis de listicle-page qui est la class du div ? ... là tu perds des éléments à mon sens !

Le code de d3d9x est plus simple et plus efficace !

Bonjour,

merci d3d9x et Steelson

Getelementsbyclassname ne marche pas pour ma version d'Excel d3d9x.

Le résultat est correct dans l'affichage "Exécution" avec debug.Print mais on n'obtient que quelque paragraphes dans la Feuil Excel.

Je joins le fichier montrant les résultats chez moi.

Getelementsbyclassname ne marche pas pour ma version d'Excel d3d9x.

Tiens, tu confirmes, c'est capricieux, d'habitude cela ne fonctionne pas mais directement avec le fichier de d3d9x cela a fonctionné chez moi (pour une fois !).

Je n'ai pas "la" solution mais je vais dans ce cas repartir de ton code (pendant mes loisirs de ce jour ...)

Je te remercie!

A nouveau, l'indentation ne permet pas une détection des erreurs.

Ensuite, le i=1 étant réinitialisé dans la boucle, certaines données étaient effacées

J'ai ajouté dans le debug print le i, le j, et la longueur du texte récupéré (je suspectais une troncature)

Private Sub ExtractionParagraphe()

    Dim oXMLPage As Object
    Dim aHTML As Object
    Dim sURL As String
    Dim i As Integer
    Dim j As Integer

    Dim articles As Object
    Dim article As Object

    Set oXMLPage = CreateObject("MSXML2.ServerXMLHTTP")
    Set aHTML = CreateObject("htmlfile")

    sURL = "http://www.readersdigest.ca/health/conditions/6-ways-soothe-foot-pain/view-all/"

    oXMLPage.Open "GET", sURL, False
    oXMLPage.send

    aHTML.body.innerHTML = oXMLPage.responseText
    Set oXMLPage = Nothing

    Set div = aHTML.getElementsByTagName("div")

    i = 1
    For Each ptext In div
        If ptext.className = "listicle-page" Then
            For Each h In ptext.getElementsByTagName("h2")
                Debug.Print i & " :: " & Len(h.innerText) & " :: " & h.innerText
                Sheets("Feuil1").Range("A" & (i + 1)).Value = h.innerText
                j = 1
                For Each p In ptext.getElementsByTagName("p")
                    Debug.Print i & "-" & j & " :: " & Len(p.innerText) & " :: " & p.innerText
                    Sheets("Feuil1").Cells(i, (j + 1)).Value = p.innerText
                    j = j + 1
                Next p
                i = i + 1
            Next h
        End If
    Next ptext

End Sub

regarde si tu y trouves tous les éléments

Oui tout les éléments sont là. mais en désordre.

Ouf, donc on a progressé !

Mais c'est quoi le bon ordre ? car on ne fait rien d'autre que lire la page web séquentiellement ...

Bonjour à tous les deux,

Copiez-collez mon code complet afin que ça fonctionne.

En effet vous utilisez tous les deux

Dim aHTML As Object

Alors qu'il faut utiliser

Dim aHTML As HTMLDocument

Mon code est censé générer le résultat souhaité initialement.

Merci pour ton code.

... il faut utiliser

Dim aHTML As HTMLDocument

Mon code est censé générer le résultat souhaité initialement.

Mais comme il y a aussi

Set aHTML = CreateObject("htmlfile")

cela doit donner la même chose normalement

J'ai essayé les 2 et cela fonctionne, mais ne donne pas exactement le même résultat !

Voir Feuil1 et Feuil2

16getelements.xlsm (20.51 Ko)

Bjr,

Pour faire simple je cherche à extraire seulement les paragraphes qui se trouvent dans la balise <p>...</p> mais sans succès . Où est l'erreur.

Je joins un fichier test.

9getelements-2.xlsm (18.46 Ko)

Bonjour,

dis moi si ok (c'est bon chez moi)

Sub Extraction()

    Dim oXMLPage As Object
    Dim aHTML As Object
    Dim sURL As String
    Dim i As Integer
    Dim j As Integer

    Dim articles As Object
    Dim article As Object

    Set oXMLPage = CreateObject("MSXML2.ServerXMLHTTP")
    Set aHTML = CreateObject("htmlfile")

    sURL = "http://www.readersdigest.ca/health/conditions/6-ways-soothe-foot-pain/view-all/"

    oXMLPage.Open "GET", sURL, False
    oXMLPage.send

    aHTML.body.innerHTML = oXMLPage.responseText
    Set oXMLPage = Nothing

    Set div = aHTML.getElementsByTagName("div")

    i = 1
    For Each ptext In div
        If ptext.className = "listicle-page" Then
            'Debug.Print ptext.innerHTML
            For Each p In ptext.getElementsByTagName("p")
                'Debug.Print p.innerHTML
                Sheets("Feuil1").Range("A" & (i)).Value = p.innerText
                i = i + 1
            Next
        End If
    Next ptext

End Sub
28getelements-2.xlsm (15.96 Ko)
Rechercher des sujets similaires à "extraction html"