Extraire des données sur plusieurs pages webs

Bonjour Tout le monde,

Je demande votre assistance afin de m'aider à résoudre ce problème d'extraction de données sur plusieurs pages web. En effet, j'ai consulté les préoccupations de certaines personnes, j'ai vu que mon problème a déjà été posé et résolu. Mais malheureusement, je n'arrive pas à l'appliquer à mes données. . Quand j'essai de voir comment ça marche avec les programmes des autres, je n'y arrive pas.

Me concernant, pour chaque site, j'ai besoin d'extraire que les information suivantes : La nature de l'ouvrage, La profondeur atteinte, La date de fin des travaux (qui se trouvent dans la description technique) , L'identifiant national de l'ouvrage, Le nom de la commune, son code postal (qui se trouvent dans la localisation).

Serait-il possible que quelqu'un m'aide ? Merci pour votre compréhension.

J'ai environs 2000 sites à explorer. je vous ai mis dans le fichier excel joint la liste de seulement 5 sites. Une explication du fonctionnement me permettrait moi même de l'appliquer aux autres sites. Merci d'avance.

Bonjour,

Voici une piste qu'il te faudra adapter. Le code appelle une fonction (Excel-Malin.com) et ensuite, il épure afin de récupérer les valeurs éventuellement intéressantes. Les résultats en colonne A de la feuille active :

Sub ExempleExtractionHTML()

    Dim CodeHTML
    Dim Tbl
    Dim Chaine As String
    Dim I As Long
    Dim J As Long
    Dim K As Long

    On Error GoTo ExempleErreur

    Columns("A:A").Cells.Clear

    CodeHTML = ExtraireSourceHTML("http://ficheinfoterre.brgm.fr/InfoterreFiche/ficheBss.action?id=BSS001DUCP")

    Tbl = Split(CodeHTML, vbCrLf)

    For I = 0 To UBound(Tbl)
        If InStr(Tbl(I), "Localisation") <> 0 Then Exit For
    Next I

    For J = I To UBound(Tbl)

        Chaine = Application.Clean(Tbl(J))

        Chaine = Replace(Chaine, "</h2>", "")
        Chaine = Replace(Chaine, "<h3>", "")
        Chaine = Replace(Chaine, "</h3>", "")
        Chaine = Replace(Chaine, "<span>", "")
        Chaine = Replace(Chaine, "</span>", "")
        Chaine = Replace(Chaine, "&nbsp;", "")
        Chaine = Replace(Chaine, "<br />", "")
        Chaine = Replace(Chaine, "<td>", "")
        Chaine = Replace(Chaine, "</td>", "")
        Chaine = Replace(Chaine, "<tr>", "")
        Chaine = Replace(Chaine, "</tr>", "")
        Chaine = Replace(Chaine, "<th>", "")
        Chaine = Replace(Chaine, "</th>", "")
        Chaine = Replace(Chaine, "<table>", "")
        Chaine = Replace(Chaine, "</table>", "")
        Chaine = Replace(Chaine, "</div>", "")
        Chaine = Replace(Chaine, "<ul>", "")
        Chaine = Replace(Chaine, "</ul>", "")
        Chaine = Replace(Chaine, "</body>", "")

        If InStr(Chaine, "<h") <> 0 Then Chaine = ""
        If InStr(Chaine, "</h") <> 0 Then Chaine = ""
        If InStr(Chaine, "<d") <> 0 Then Chaine = ""
        If InStr(Chaine, "<a") <> 0 Then Chaine = ""
        If InStr(Chaine, "src") <> 0 Then Chaine = ""
        If InStr(Chaine, "img") <> 0 Then Chaine = ""
        If InStr(Chaine, "li") <> 0 Then Chaine = ""
        If InStr(Chaine, "<!") <> 0 Then Chaine = ""
        If InStr(Chaine, "<table") <> 0 Then Chaine = "Tableau :"

        Chaine = Trim(Chaine)

        If Chaine <> "" Then

            K = K + 1
            Cells(K, 1) = Chaine

        End If

    Next J

    Exit Sub

ExempleErreur:

    MsgBox "Une erreur est survenue..."

End Sub

Public Function ExtraireSourceHTML(LienURL As String)

'par: Excel-Malin.com ( http://excel-malin.com )

On Error GoTo ExtraireSourceHTMLErreur

  With CreateObject("MSXML2.XMLHTTP")
    .Open "GET", LienURL, False
    .Send
      If .readyState = 4 Then
        If .Status <> 200 Then
            ExtraireSourceHTML = CVErr(xlErrNA)
        Else
            ExtraireSourceHTML = .ResponseText
        End If
      Else
        ExtraireSourceHTML = CVErr(xlErrNA)
      End If
  End With

Exit Function

ExtraireSourceHTMLErreur:
    ExtraireSourceHTML = CVErr(xlErrNA)

End Function

Bonjour M. Theze,

Je vous remercie pour le code que vous avez écrit pour mon exercice. En effet, je ne sais pas comment l'appliquer à mon fichier excel.

Dois-je le faire depuis Visual B ? ou depuis mon fichier Excel ?

Car, j'ai la version d'Excel 2016 et dans les options "Data"-->"From Web", on ne me propose pas d'entrer le code. Ou alors, c'est moi qui ne m'y connais pas vraiment en programmation. C'est certainement dû à ça.

Pourriez-vous le donner une piste pour utiliser ce code ? Merci pour votre compréhension.

Bonjour,

Tu fais la combinaison de touches Alt+F11 tu te retrouve dans le VBE (éditeur de code Visual Basic), tu cliques sur le menu insertion ---> "Module", dans la partie droite qui vient de s'afficher, tu colles le code puis tu presses la touche F5 en ayant au préalable mis le curseur n'importe où dans la Sub "ExempleExtractionHTML()" et tu retourne dans Excel pour voir le résultat !

Le valeurs seront celles de l'adresse "http://ficheinfoterre.brgm.fr/InfoterreFiche/ficheBss.action?id=BSS001DUCP", c'est pour le test ensuite, tu reviens ici afin d'avancer sur ton projet en disant ce que tu souhaites de plus.

Attention, le code que je t'ai donné est une ébauche, il va falloir encore fortement le modifier

Bonjour,

D'accord merci pour ces explications. Je vais essayer ça et tenter de l'adapter au mieux à mon fichier. Je vous ferrai un retour de ce que ça donne. Merci à vous et à bientôt.

Cordialement

Bonjour M. Theze,

J'espère que vous allez bien. Désolé pour le retard, c'est juste que j'étais occupé à faire d'autres travaux étant donné que je suis en stage.

Voilà, j'ai essayé le programme que vous m'avez envoyé et il marche très bien pour le point en question.

Je reviens vers vous pour vous en informer.

Pour la suite, ce que je veux faire, c'est de pouvoir extraire ces informations pour plus de 2000 points. Étant donné que le programme marche pour un point, comment faire pour qu'il prenne en compte toute une liste de points ?

Merci bien à vous. Je vous dis encore merci d'avance.

Voici en quelque sorte le genre de fichier que j'aimerais avoir pour l'ensemble de mes points.