1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59
| Option Explicit
Sub Main()
Dim Fichier As String, Rep As String
Rep = ThisWorkbook.Path & "\PC HTML\" 'les fichiers html sans dans le dossier PC HTML dans le même dossier que le fichier excel
Fichier = Dir(Rep & "*.html")
Feuil1.UsedRange.Offset(1).ClearContents
Do While Fichier <> ""
ImportHtml Rep & Fichier
Fichier = Dir
Loop
End Sub
Private Function GetData(ByVal Fichier As String) As String
Dim oFSO As Object, oFS As Object
Dim sText As String
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFS = oFSO.OpenTextFile(Fichier)
Do Until oFS.AtEndOfStream
sText = oFS.ReadAll()
Loop
GetData = sText
Set oFSO = Nothing
Set oFS = Nothing
End Function
Private Sub ImportHtml(ByVal Fichier As String)
Dim i As Integer, j As Integer, k As Integer
Dim Tr As Object
Dim N As Long
Dim Tb
With CreateObject("htmlfile")
.body.innerhtml = GetData(Fichier)
Set Tr = .GetElementsByTagName("tr")
ReDim Tb(1 To Tr.Length)
For i = 0 To Tr.Length - 1
Tb(i + 1) = Tr(i).GetElementsByTagName("td")(1).innertext
Next i
Set Tr = Nothing
End With
With Feuil1
N = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
.Cells(N, 1) = Tb(30)
.Cells(N) = Tb(29)
.Cells(N, 3) = Tb(13)
.Cells(N, 4) = Tb(4)
.Cells(N, 5) = Tb(5)
.Cells(N, 6) = Tb(7)
.Cells(N, 7) = Tb(11)
.Cells(N, 8) = Tb(24)
.Cells(N, 9) = Tb(12)
.Cells(N, 10) = Tb(14)
.Cells(N, 11) = Tb(18) & " (" & Tb(19) & ")"
End With
End Sub |
Partager