XL 2016 Convertir fichier HTML en format CSV

Sub test()
 Columns("B:B").NumberFormat = "@"
  
    With ActiveSheet.QueryTables.Add(Connection:= _
        "FINDER;file:///C:/Users/polux/Desktop/htmltocsv.html", Destination:=Range("$A$1"))
        .Name = "htmlto"
        .FieldNames = True
        .PreserveFormatting = True
         .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
          .AdjustColumnWidth = True
         .WebSelectionType = xlSpecifiedTables
        .WebFormatting = True
        .WebTables = "2"
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
         .Refresh BackgroundQuery:=False
    .Delete
    End With
  Columns("B:B").NumberFormat = "@"
  
End Sub

Sub test_B()
Dim HTML_file$
HTML_file = "C:\Users\STAPLE\htmltocsv\htmltocsv.html"
With ActiveSheet.QueryTables.Add(Connection:= _
"FINDER;file:///" & HTML_file, Destination:=Cells(1))
.Name = "htmlto": .FieldNames = True: .PreserveFormatting = True
.BackgroundQuery = True: .RefreshStyle = 1
.WebSelectionType = xlSpecifiedTables: .WebTables = "2"
.WebPreFormattedTextToColumns = True: .WebConsecutiveDelimitersAsOne = True
.Refresh BackgroundQuery:=False: .Delete
End With
End Sub

Option Explicit
Function ConvertHtmlToCsv(fichier)
    Dim laChaine$, trs As Object, X&, I&, lesgosses As Object, g&, ent
    X = FreeFile: Open fichier For Binary Access Read As #X: laChaine = String(LOF(X), " "): Get #X, , laChaine: Close #X
    With CreateObject("htmlfile")
        .body.innerhtml = laChaine
        Set trs = .getelementsbytagname("TABLE")(1).getelementsbytagname("tr")
        For I = trs.Length - 2 To 0 Step -1
            If trs(I).ChildNodes.Length = 1 Then trs(I + 1).appendchild (trs(I).ChildNodes(0))
        Next
        ReDim tablo(0 To trs.Length - 1, 1 To 6)
        For I = 1 To trs.Length - 1
            If trs(I).ChildNodes.Length > 0 Then
                Set lesgosses = trs(I).ChildNodes
                For g = 0 To lesgosses.Length - 1: tablo(X, g + 1) = Trim(lesgosses(g).innertext): Next
                X = X + 1:
            End If
        Next
        Cells(1, 1).Resize(UBound(tablo), UBound(tablo, 2)) = tablo
        ent = Array("code", "ID", "Date Acqusition", "Nombre", "Dernière utilisation", "Descriptif")
        Cells(1, 1).Resize(, UBound(ent) + 1) = ent
    End With
End Function
Sub test()
    ConvertHtmlToCsv "C:\Users\polux\DeskTop\htmltocsv.html"
End Sub

Option Explicit
Function ConvertHtmlToCsv(fichier)
    Dim laChaine$, trs As Object, X&, I&, lesgosses As Object, g&, ent, a
    X = FreeFile: Open fichier For Binary Access Read As #X: laChaine = String(LOF(X), " "): Get #X, , laChaine: Close #X
    With CreateObject("htmlfile")
        .body.innerhtml = laChaine
        Set trs = .getelementsbytagname("TABLE")(1).getelementsbytagname("tr")
        For I = trs.Length - 2 To 0 Step -1
            If trs(I).ChildNodes.Length = 1 Then trs(I + 1).appendchild (trs(I).ChildNodes(0))
        Next
        ReDim tablo(0 To trs.Length - 1, 1 To 6)
        For I = 1 To trs.Length - 1
            If trs(I).ChildNodes.Length > 0 Then
                Set lesgosses = trs(I).ChildNodes
                For g = 0 To lesgosses.Length - 1
                    If IsDate(Trim(lesgosses(g).innertext)) Then a = CDate(Trim(lesgosses(g).innertext)) Else a = Trim(lesgosses(g).innertext)
                    tablo(X, g + 1) = a: Next
                If tablo(X, 6) = "" Then tablo(X, 6) = tablo(X - 1, 6)
                X = X + 1:
            End If
        Next
        With Range("A:F"):
            .Clear
            .Columns(2).NumberFormat = "@"
            .Range("C:C,E:E").NumberFormat = "m/d/yyyy"
            Cells(1, 1).Resize(UBound(tablo), UBound(tablo, 2)) = tablo
            ent = Array("code", "ID", "Date Acqusition", "Nombre", "Dernière utilisation", "Descriptif")
            Cells(1, 1).Resize(, UBound(ent) + 1) = ent
            .EntireColumn.AutoFit
        .HorizontalAlignment = xlCenter
        End With
    End With
End Function
Sub test()
    ConvertHtmlToCsv "C:\Users\polux\DeskTop\htmltocsv.html"
End Sub

Option Explicit
Function ConvertHtmlToCsv(fichier)
    Dim laChaine$, trs As Object, X&, I&, lesgosses As Object, g&, ent, a, elem
    X = FreeFile: Open fichier For Binary Access Read As #X: laChaine = String(LOF(X), " "): Get #X, , laChaine: Close #X
    With CreateObject("htmlfile")
        .body.innerhtml = laChaine
       
        For Each elem In .all
        If elem.tagname = ("TABLE") And elem.innerhtml Like "*Description/Code*" Then
               Set trs = elem.getelementsbytagname("tr"): Exit For
        End If
        Next
     
       For I = trs.Length - 2 To 0 Step -1
            If trs(I).ChildNodes.Length = 1 Then trs(I + 1).appendchild (trs(I).ChildNodes(0))
        Next
        ReDim tablo(0 To trs.Length - 1, 1 To 6)
        For I = 1 To trs.Length - 1
            If trs(I).ChildNodes.Length > 0 Then
                Set lesgosses = trs(I).ChildNodes
                For g = 0 To lesgosses.Length - 1
                    If IsDate(Trim(lesgosses(g).innertext)) Then a = CDate(Trim(lesgosses(g).innertext)) Else a = Trim(lesgosses(g).innertext)
                    tablo(X, g + 1) = a: Next
                If tablo(X, 6) = "" Then tablo(X, 6) = tablo(X - 1, 6)
                X = X + 1:
            End If
        Next
        With Range("A:F"):
            .Clear
            .Columns(2).NumberFormat = "@"
            .Range("C:C,E:E").NumberFormat = "m/d/yyyy"
            Cells(1, 1).Resize(UBound(tablo), UBound(tablo, 2)) = tablo
            ent = Array("code", "ID", "Date Acqusition", "Nombre", "Dernière utilisation", "Descriptif")
            Cells(1, 1).Resize(, UBound(ent) + 1) = ent
            .EntireColumn.AutoFit
        .HorizontalAlignment = xlCenter
        End With
    End With
End Function
Sub test()
    ConvertHtmlToCsv "C:\Users\polux\DeskTop\test.html"
End Sub