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