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
| Sub test()
Columns("A:l").Clear
Dim ReQ As Object, UrL As String
UrL = "http://www.geny.com/partants-pmu/2015-05-19-longchamp-pmu-prix-des-gobelins_c714591"
Set ReQ = CreateObject("microsoft.xmlhttp")
ReQ.Open "POST", UrL, False
ReQ.setRequestHeader "Accept", "text/html, application/xhtml+xml, */*"
ReQ.setRequestHeader "Accept-Language", "fr-FR"
ReQ.setRequestHeader "User-Agent", "Mozilla/5.0 (compatible; MSIE 10.0; Windows NT 6.1; WOW64; Trident/6.0)"
ReQ.setRequestHeader "Accept-Encoding", "gzip, deflate"
ReQ.setRequestHeader "Host", "www.geny.com"
ReQ.setRequestHeader "DNT", 1
ReQ.setRequestHeader "Connection", "Keep - Alive"
ReQ.setRequestHeader "Cookie", " JSESSIONID=3E554B80B1ABBC36A2C53EC91C219C77.raoul_1;"
ReQ.send
'MsgBox ReQ.responsetext
Set fauxdoc = CreateObject("htmlfile")
With fauxdoc
.body.innerhtml = ReQ.responsetext
Set grouptable = .getelementsbytagname("TABLE")
For i = 0 To grouptable.Length - 1
If grouptable(i).ParentNode.ID = "dt_partants" Then Set matable = grouptable(i)
Next
For Each elem In matable.all
If elem.tagname = "TD" Then elem.innerhtml = elem.innertext
Next
faire = .ParentWindow.clipboardData.SetData("text", matable.outerhtml)
With Sheets(1)
Set cel = .Cells(Rows.Count, 1).End(xlUp).Offset(2, 0)
cel.Select
.Paste:
End With
faire = .ParentWindow.clipboardData.ClearData("text")
End With
End Sub |
Partager