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
| 'Nécessite d 'activer les references
'Microsoft HTML Objects Library
'et
'Microsoft Internet Controls
Dim IE As InternetExplorer
Dim maPageHtml As HTMLDocument
Dim Htable As IHTMLElementCollection
Dim maTable As IHTMLTable
Dim j As Integer, i As Integer
Dim Cible As String
Set IE = CreateObject("InternetExplorer.Application")
IE.Visible = True
IE.navigate "http://nomdusite.fr"
Do Until IE.readyState = READYSTATE_COMPLETE
DoEvents
Loop
Set maPageHtml = IE.document
'objet type table
Set Htable = maPageHtml.getElementsByTagName("table")
'premier tableau dans la page Web
Set maTable = Htable(0)
'boucle sur toutes les lignes du tableau
For i = 1 To maTable.Rows.Length
'boucle sur les cellules dans chaque ligne
For j = 1 To maTable.Rows(i - 1).Cells.Length
Cible = maTable.Rows(i - 1).Cells(j - 1).innerHTML
If Left(Cible, 8) = "<A href=" Then
ActiveSheet.Hyperlinks.Add Cells(i, j), Mid(Cible, 10, InStr(10, Cible, ">") - 11)
Else
Cells(i, j) = maTable.Rows(i - 1).Cells(j - 1).innerText
End If
Next j
Next i |
Partager