Copier les données HTML vers Excel

**JMAROUF** · 09/08/2022, 17h40

Bonjour,
j'essaie de copier la valeur d'un tableau HTML sur Excel mais le problème c'est que la valeur du champ input ne passe pas, et quand je décommente la ligne

Code :

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

Sheets(1).Cells(iRow, iCol) = Trim(HTML_Content.getElementsByTagName("td")(0).getElementsByTagName("input")(0).Value)

je reçois l'erreur 424, quelqu'un pourrait-il me débloquer SVP?

voici les scripts que j'utilise:

Code HTML :

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
 
<!DOCTYPE html>
<html>
<body>
 
	<table>
	  <tr>
		<th>Company</th>
		<th>Contact</th>
		<th>Country</th>
		<th>Country</th>
	  </tr>
	  <tr>
		<td>Alfreds Futterkiste</td>
		<td>HIND FARCHI</td>
		<td><input type="text" id="name" name="name" required
       minlength="4" maxlength="8" size="10"></td>
		<td>Germany</td>
	  </tr>
	  <tr>
		<td>Centro comercial</td>
		<td>Francisco Chang</td>
		<td><input type="text" id="name" name="name" required
       minlength="4" maxlength="8" size="10"></td>
		<td>Mexico</td>
	  </tr>
 
	</table>
 
</body>
</html>

Code VBA :

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
Sub HTML_Table_To_Excel()
 
    Dim htm As Object
    Dim Tr As Object
    Dim Td As Object
    Dim Tab1 As Object
 
    'Replace the URL of the webpage that you want to download
    Web_URL = "file:///C:/Users/jmarouf/Desktop/RDGI.html"
 
    'Create HTMLFile Object
    Set HTML_Content = CreateObject("htmlfile")
 
    'Get the WebPage Content to HTMLFile Object
    With CreateObject("msxml2.xmlhttp")
        .Open "GET", Web_URL, False
        .send
        HTML_Content.body.innerHTML = .responseText 'this is the highlighted part for the error
    End With
 
    Column_Num_To_Start = 1
    iRow = 2
    iCol = Column_Num_To_Start
    iTable = 0
 
    'Loop Through Each Table and Download it to Excel in Proper Format
    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
                    Sheets(1).Cells(iRow, iCol).Select
                'Sheets(1).Cells(iRow, iCol) = Trim(HTML_Content.getElementsByTagName("td")(0).getElementsByTagName("input")(0).Value)
                    Sheets(1).Cells(iRow, iCol) = Td.innerText
                    iCol = iCol + 1
                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
 
    MsgBox "Process Completed"
End Sub

**EricDgn** · 14/08/2022, 11h08

Bonjour,

Une solution, valable pour autant que la structure soit vraiment bien toujours la même (Input en colonne 3):

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
Option Explicit
 
Sub HTML_Table_To_Excel()
 
    Dim htm As Object
    Dim Tr As Object
    Dim Td As Object
    Dim tab1 As Object
    Dim Web_URL As String
    Dim HTML_Content As Object
    Dim Column_Num_To_Start As Long
    Dim iRow As Long, iCol As Long, iTable As Long
 
 
    'Replace the URL of the webpage that you want to download
    Web_URL = "file:///C:/Users/jmarouf/Desktop/RDGI.html"
 
    'Create HTMLFile Object
    Set HTML_Content = CreateObject("htmlfile")
 
    'Get the WebPage Content to HTMLFile Object
    With CreateObject("msxml2.xmlhttp")
        .Open "GET", Web_URL, False
        .send
        HTML_Content.body.innerHTML = .responseText 'this is the highlighted part for the error
        Debug.Print .responseText
    End With
 
    Column_Num_To_Start = 1
    iRow = 2
    iCol = Column_Num_To_Start
    iTable = 0
 
    'Loop Through Each Table and Download it to Excel in Proper Format
    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
                    Sheets(1).Cells(iRow, iCol) = Td.innerText
                    If iRow > 2 And iCol = 3 Then   '--- n'est pas la ligne de titre, est la colonne 3
                        Sheets(1).Cells(iRow, 3) = HTML_Content.getElementsByTagName("input")(iRow - 3).Value
                    End If
                    iCol = iCol + 1
                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
 
    MsgBox "Process Completed"
End Sub

Cordialement.

Copier les données HTML vers Excel [XL-MAC 2016]

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager