Parser page HTML

Salut

Je cherche à récupérer des infos sur cette page :

J'ai besoin de récupérer uniquement les projet actifs, leur nom et l'adresse de la page correspondante.

Mon principal soucis est de ne pas réussir à récupérer les URL.

Bref, je galère.

L'idée serait d'avoir in fine une variable tableau sous forme

Projet1 URL1
Projet2 URL2

avec uniquement les projets actifs.

Ci-dessous le code que j'ai tenté (avec Site = l'url donnée au début du post) :

Sub LireMoo(Site As String)
    Dim oHtml As New HTMLDocument
    Dim Elem1 As Object, Elem2 As Object, Elem3 As Object

    oHtml.body.innerHTML = HTML(Site)
    For Each Elem1 In oHtml.getElementsByTagName("tr")
        For Each Elem2 In Elem1.getElementsByTagName("td")
            For Each Elem3 In Elem2.getElementsByTagName("font")
                Debug.Print Elem3.innerText
            Next Elem3
        Next Elem2
    Next Elem1 
End Sub

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

Si c'est plus simple de récupérer l'ensemble des projets, ce n'est pas un soucis, je ferai la dichotomie actif/inactif en aval.

Merci d'avance pour votre aide.

Bon, j'ai pas réussi à trouver comment on édite ou supprime un topic, donc je m'auto-réponds

J'arrive à sortir les infos que je veux ( \o/ ), mais... problème trivial d'alimentation du tableau avec une bonne vieille erreur 13 (incompatibilité de type). Voilà le code :

Sub LireMoo(Site As String, ByRef Tableau)
    Dim oHtml As New HTMLDocument
    Dim Elem1 As Object, Elem2 As Object, Elem3 As Object, Elem4 As Object
    Dim URL
    Dim i%, j%, deb%, fin%

    i = 1
    j = 1

    oHtml.body.innerHTML = HTML(Site)
    For Each Elem1 In oHtml.getElementsByTagName("tr")
        For Each Elem2 In Elem1.getElementsByTagName("td")
            For Each Elem3 In Elem2.getElementsByTagName("font")
                For Each Elem4 In Elem3.getElementsByTagName("font")
                    If Trim(Elem4.innerText) <> "Project" And Trim(Elem4.innerText) <> "Description" And Trim(Elem4.innerText) <> "Status" And InStr(1, Elem4.innerText, "©") = 0 Then
                        Tableau(i, j) = Trim(Elem4.innerText)
                        If Elem4.innerText = "active" Or Elem4.innerText = "completed" Then
                            i = i + 1
                            j = 1
                        Else
                            j = j + 1
                        End If
                        If InStr(1, Elem4.innerHTML, "projects") > 0 Then
                            deb = InStr(1, Elem4.innerHTML, "/")
                            fin = InStr(10, Elem4.innerHTML, ">") - 2
                            URL = Site & Mid(Elem4.innerHTML, deb + 1, fin - deb)
                            Tableau(i, j) = URL
                        End If
                    End If
                Next Elem4
            Next Elem3
        Next Elem2
    Next Elem1

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

Bonjour,

Une proposition Power Query et VBA.

Power Query pour la requête Web et VBA pour la création des liens hypertextes.

L'actualisation s'effectue à l'ouverture du classeur.

A te relire.

Cdlt.

Salut,

J'ai une erreur 1004 (échec lors de l'initialisation de la source de données) sur la ligne

Range("Output").ListObject.QueryTable.Refresh BackgroundQuery:=False

Cependant je cherche juste à récupérer ces données dans une variable tableau, pas à les afficher sur une feuille (la variable tableau sera exploitée ulérieurement pour aller taper sur différentes page web).

Cela dit je ne connaissais pas Power Query, ça a l'air interessant. Je vais creuser de ce côté.

Merci.

Re,

Après nouvelle vérification, je n'ai pas d'erreur à l'ouverture du classeur.

Le résultat est celui-ci :

Effectivement, j'étais sur un poste avec Office 2007. En passant sur un poste avec Office 2016, ton code marche parfaitement.

Re,

Merci, il n'y pas de quoi...