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
| Option Base 1
Dim URL As String, Lapage_en_HTML
Dim tablo As Variant
Function GetSourceCode(sURL, Optional au_format_text As Boolean = "false") As String
Set Lapage_en_HTML = CreateObject("Microsoft.XMLHTTP") 'instancie l'object
Lapage_en_HTML.Open "GET", sURL 'ouvre l'url dans l'object
Lapage_en_HTML.Send
Do: DoEvents: Loop While Lapage_en_HTML.ReadyState <> 4 'attendre que la page soit chargée
'exemple de code source End of placement</td><td>03/31/2011
GetSourceCode = Lapage_en_HTML.responseText
End Function
Sub recup_table()
URL = "http://www.nasdaq.com/symbol/f/historical"
tablevide
Dim entete(1, 6), grille
Dim tablogrille(1000, 6)
tablo = Split(GetSourceCode(URL), "class=""table-headtag"">")(1)
grille = Split(tablo, "</thead>")(1): grille = Split(grille, "</tbody>")(0): grille = Split(grille, "<tr>")
tabloentete = Split(tablo, "<tbody>")(0): tabloentete = Split(tabloentete, "<th>")
For i = 1 To UBound(tabloentete)
entete(1, i) = Replace(Replace(Split(tabloentete(i), "<")(0), " ", ""), Chr(10), "")
Next
For i = 1 To UBound(grille)
'ReDim Preserve tablogrille(1 To i, 1 To 6)
tablogrille(i, 1) = Replace(Replace(Split(Split(grille(i), Chr(10))(3), "<")(0), Chr(10), ""), " ", "")
tablogrille(i, 2) = Replace(Replace(Split(Split(grille(i), "<td>")(2), Chr(10))(1), " ", ""), " ", "")
tablogrille(i, 3) = Replace(Replace(Split(Split(grille(i), "<td>")(3), Chr(10))(1), " ", ""), " ", "")
tablogrille(i, 4) = Replace(Replace(Split(Split(grille(i), "<td>")(4), Chr(10))(1), " ", ""), " ", "")
tablogrille(i, 5) = Replace(Replace(Split(Split(grille(i), "<td>")(5), Chr(10))(1), " ", ""), " ", "")
tablogrille(i, 6) = Replace(Replace(Split(Split(grille(i), "<td>")(6), Chr(10))(1), " ", ""), " ", "")
Next
[A2].Resize(1, 6) = entete
[A3].Resize(1000, 6) = tablogrille
End Sub
Sub tablevide()
Columns("A:H") = ""
End Sub |
Partager