Discussion :

[Rudy1909]

Bonjour à tous,
J'ai ce code VBA que j'ai écris pour extraire des données dans un fichier HTML et le ranger dans une feuille excel.
Le code marche parfaitement en France, mais quand une personnne se trouvant en Chine l'utilise ça afficher 'Run Time Error - 62 (Input Past End of File)'.
Si vous pouvez m'aider svp.
Merci.
Rudy

Le code est le suivant:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
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

[EricDgn]

Bonjour,

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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.