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
| Dim madate
Public Function recupcodesoource(url)
Dim ReQ As Object
Set ReQ = CreateObject("microsoft.xmlhttp")
With ReQ
.Open "post", url, False
.send
recupcodesoource = .responsetext
End With
End Function
Sub test2()
Sheets("liste").Range("A2", Cells(Rows.Count, "d")).Clear
With CreateObject("htmlfile")
madate = Date 'CDate("15/07/2018")'mettre la date que l'on veut
.body.innerhtml = recupcodesoource("http://www.geny.com/reunions-courses-pmu?date=" & Format(madate, "yyyy-mm-dd"))
i = 1
For Each elem In .all
If elem.classname = "yui-gc cartoucheReunion" Then
i = i + 1:
With Cells(i, 1)
.Value = elem.ChildNodes(0).innertext
.Interior.Color = RGB(0, 100, 0): .Font.Color = vbWhite
Cells(i, 1).Resize(1, 4).MergeCells = True
End With
ElseIf elem.classname = "yui-u first nomCourse" Then
i = i + 1:
With Cells(i, 1)
.Value = elem.innertext
.Interior.Color = RGB(230, 255, 230): .Font.Color = vbBlack
End With
ElseIf elem.innertext = "partants/stats/prono" Then
On Error Resume Next
Cells(i, 2) = "_c" & Split(elem.href, "_c")(1):
ActiveSheet.Hyperlinks.Add Anchor:=Cells(i, 3), Address:="http://www.geny.com/" & Split(elem.href, "about:/")(1), _
TextToDisplay:="page du tableau chevaux "
'Cells(i, 3) = "http://www.geny.com/" & Split(elem.href, "about:/")(1):
'Cells(i, 4) = "http://www.geny.com/" & Replace(Split(elem.href, "about:/")(1), "partants-pmu/", "cotes/")
ActiveSheet.Hyperlinks.Add Anchor:=Cells(i, 4), Address:="http://www.geny.com/" & Replace(Split(elem.href, "about:/")(1), "partants-pmu/", "cotes/"), _
TextToDisplay:="page des cotes"
Err.Clear
End If
Next
End With
Columns("A:D").AutoFit
End Sub |