ImportXML et XPath en Excel

Bonjour,

je tente de reproduire sur excel les superbes fonctions de Google Sheets que l'on trouve ici https://forum.excel-pratique.com/astuces/google-sheets-importxml-et-xpath-150789

pour démarrer, j'ai traduit la fonction ImportHTML (https://forum.excel-pratique.com/astuces/google-sheets-importhtml-150784), ce qui est loin d'être optimisé mais m'a permis de mettre en place quelques briques de code ...

la prochaine étape sera de décortiquer XPath pour les utilisations les plus courantes

une des difficultés est qu'il faille pouvoir écrire dans des cellules voisines avec une fonction (mais que nous avions déjà traité ici)

si vous avez des idées notamment sur le dimensionnement du tableau, je suis preneur (ici j'ai fait un premier balayage)

Function ImportHTML(url As String, cas As String, Optional num As Integer = 1)
Application.Volatile
    Evaluate "resultat(" & Application.Caller.Offset(1, 0).Address(False, False) & ",""" & url & """," & num & ")"
    ImportHTML = "Table >"
End Function

Sub resultat(cel As Range, url As String, num As Integer)

Dim HTMLPage As New HTMLDocument
Dim tbl

    With CreateObject("WINHTTP.WinHTTPRequest.5.1")
        .Open "GET", url, False
        .send
        HTMLPage.body.innerHTML = .responseText
    End With

    Set HTMLTables = HTMLPage.getElementsByTagName("table")

    ligne = 0: colmax = 0
    For Each HTMLRow In HTMLTables(num).getElementsByTagName("tr")
        ligne = ligne + 1
        colonne = 0
        For Each HTMLCell In HTMLRow.Children
            colonne = colonne + 1
        Next HTMLCell
        colmax = Application.Max(colmax, colonne)
    Next HTMLRow

    ReDim tbl(1 To ligne, 1 To colmax)
    ligne = 0
    For Each HTMLRow In HTMLTables(num).getElementsByTagName("tr")
        ligne = ligne + 1
        colonne = 0
        For Each HTMLCell In HTMLRow.Children
            colonne = colonne + 1
            tbl(ligne, colonne) = SuppBalises(HTMLCell.innerHTML)
        Next HTMLCell
    Next HTMLRow

    cel.Resize(UBound(tbl), UBound(tbl, 2)) = tbl

End Sub

Function SuppBalises(chaine As String) As String
SuppBalises = chaine
t = Split(chaine, "<")
If UBound(t) > 0 Then
    For i = 1 To UBound(t)
        If InStr(t(i), ">") > 0 Then SuppBalises = Replace(SuppBalises, "<" & Split(t(i), ">")(0) & ">", "")
    Next
End If
End Function

nota : il est évident que pour cette fonction, une version plus optimisée est :

Steelson a écrit :

si vous avez des idées notamment sur le dimensionnement du tableau, je suis preneur (ici j'ai fait un premier balayage)

à conditions que le tableau soit bien "rectangulaire", sans trous

    lignes = HTMLTables(num).getElementsByTagName("tr").Length
    colonnes = HTMLTables(num).getElementsByTagName("tr")(1).getElementsByTagName("td").Length
    ReDim tbl(1 To lignes, 1 To colonnes)