[XL-365] Run Time Error - 62 (Input Past End of File)

Private Sub cmd_extract_Click() uf.Hide Dim html As Object Dim Tr As Object Dim Td As Object Dim Tab1 As Object Dim file As String Dim sh As Worksheet file = txt TextFile = FreeFile Open file For Input As TextFile Set HTML_Content = CreateObject("htmlfile") HTML_Content.body.innerHtml = Input(LOF(TextFile), TextFile) Column_Num_To_Start = 1 iRow = 2 iCol = Column_Num_To_Start iTable = 0 For Each Tab1 In HTML_Content.getElementsByTagName("table") With HTML_Content.getElementsByTagName("table")(iTable) For Each Tr In .Rows For Each Td In Tr.Cells Application.ScreenUpdating = False Sheets("Feuil2").Visible = True Set sh = ActiveWorkbook.Worksheets("Feuil2") With sh sh.Select .Cells(iRow, iCol).Select .Cells(iRow, iCol) = Td.innerText iCol = iCol + 1 End With Next Td iCol = Column_Num_To_Start iRow = iRow + 1 Next Tr End With iTable = iTable + 1 iCol = Column_Num_To_Start iRow = iRow + 1 Next Tab1 Sheets("Feuil2").Visible = False Application.ScreenUpdating = True End Sub

Bonjour,

A tester: utiliser une autre méthode, OpenTextFile, pour récupérer le texte du fichier.

Code:

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
Private Sub cmd_extract_Click()
 
    uf.Hide
    'Application.ScreenUpdating = False
 
    Dim HTML_Content As Object
    Dim Tr As Object
    Dim Td As Object
    Dim Tab1 As Object
    Dim sh As Worksheet
 
    Dim Column_Num_To_Start As Long:    Column_Num_To_Start = 1
    Dim iRow As Long:                   iRow = 2
    Dim iCol As Long:                   iCol = Column_Num_To_Start
    Dim iTable As Long:                 iTable = 0
 
    Set sh = ActiveWorkbook.Worksheets("Feuil2")
    Set HTML_Content = CreateObject("htmlfile")
 
    HTML_Content.body.innerHtml = TexteDe(txt) '--- txt = chemin fichier
 
    For Each Tab1 In HTML_Content.getElementsByTagName("table")
        With HTML_Content.getElementsByTagName("table")(iTable)
            For Each Tr In .Rows
                For Each Td In Tr.Cells
                    sh.Cells(iRow, iCol) = Td.innerText
                    iCol = iCol + 1
                Next Td
                iCol = Column_Num_To_Start
                iRow = iRow + 1
            Next Tr
            iTable = iTable + 1
            iCol = Column_Num_To_Start
            iRow = iRow + 1
        End With
    Next Tab1
 
    Set sh = Nothing
    Set HTML_Content = Nothing
    'Application.ScreenUpdating = True
End Sub
 
Public Function TexteDe(CheminFichier As String) As String
    Dim fso As Scripting.FileSystemObject
    Dim TxtStr As Scripting.TextStream
    Set fso = New Scripting.FileSystemObject
    Set TxtStr = fso.OpenTextFile(CheminFichier, ForReading, False, TristateMixed)
    TexteDe = TxtStr.readall
    Set TxtStr = Nothing
    Set fso = Nothing
End Function

Cordialement.