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
57
58
59
60
61
62
| Dim madate
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 test()
madate = CDate("14/07/2018") 'mettre la date que tu veux ici pas trop loin sinon les prono sont pas encore fait sur geny
Sheets("liste").Range("A2:d100").ClearContents
With CreateObject("htmlfile")
' url = "http://www.geny.com/reunions-courses-pmu" 'pour les reunions du jour
url = "http://www.geny.com/reunions-courses-pmu?date=" & Format(madate, "yyyy-mm-dd") 'pour une date precise
.body.innerhtml = recupcodesoource(url)
Set meslien = .getelementsbytagname("a")
For Each elem In meslien
'If elem.classname = "btnMulti" Or elem.classname = " btnCourse" or
If elem.href Like "*/partants-pmu*" Then
lien = Replace(elem.href, "about:", "http://www.geny.com")
'Debug.Print lien
With Sheets("liste").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
.Value = "c" & Split(lien, "_c")(1)
.Offset(0, 1) = Split(Split(lien, Format(madate, "yyyy-mm-dd") & "-")(1), "-pmu")(0)
If lien Like "*prix*" Then .Offset(0, 2) = "prix" & Split(Split(lien, "prix")(1), "_c")(0)
Sheets("liste").Hyperlinks.Add Anchor:=.Offset(0, 3), Address:=lien, _
TextToDisplay:="page du tableau chevaux "
End With
End If
Next
End With
End Sub
'recuperation des tables
Sub recuptable()
Application.DisplayAlerts = False
For Each sh In Worksheets
If sh.Name = Format(madate, "yyyy-mm-dd") Then sh.Delete
Next
Set sh2 = Sheets.Add
sh2.Name = Format(madate, "yyyy-mm-dd")
For i = 2 To Sheets("liste").Cells(Rows.Count, "D").End(xlUp).Row
t = ""
With CreateObject("htmlfile")
.body.innerhtml = recupcodesoource(Sheets("liste").Cells(i, "D").Hyperlinks(1).Address)
For Each elem In .all
If elem.classname = "yui-u first nomReunion" Then t = elem.innertext
If elem.classname = "yui-u first nomCourse" Then t = t & elem.innertext
If elem.tagname = "TD" Then elem.Style.Border = "1px solid #0B6121"
'yui-u first nomCourse
Next
.body.innerhtml = t & "<br/>" & Replace(.getelementsbytagname("table")(1).outerhtml, "about:/", "http://www.geny.com/")
.getelementsbytagname("tr")(0).Style.Backgroundcolor = "#0B6121"
.getelementsbytagname("tr")(0).Style.Color = "#FFFFFF"
.parentWindow.clipboardData.setData "Text", "<html><body>" & .body.innerhtml & "</body></html>"
With sh2.Cells(Rows.Count, 1).End(xlUp).Offset(2, 0): .Select: .Parent.Paste: End With
End With
Next
End Sub |
