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 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144
| Function reponseREq(url)
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.zeturf.fr"
req.SetRequestHeader "If-Modified-Since", "Fri, 31 Jul 2015 09:39:24 GMT"
req.SetRequestHeader "DNT", "1"
req.SetRequestHeader "Connection", "Keep - Alive"
req.send
reponseREq = req.responsetext
Set req = Nothing
End Function
' exemple http://www.zeturf.fr/fr/resultats-et-rapports/?day=2015-07-28
Function raportzeturf(oldate, hippo, nomprix)
Dim req, url
hippo = UCase(hippo): nomprix = LCase(nomprix): oldate = Format(oldate, "yyyy-mm-dd")
'on va vers les hippodromes
url = "http://www.zeturf.fr/fr/resultats-et-rapports/?day=" & oldate ' &2015-07-28
'************************************************************************************************************************************
'on va chercher le code html de la page archive generale oldate
Set document = CreateObject("htmlfile")
document.body.innerhtml = reponseREq(url)
'************************************************************************************************************************************
'on cherche le bon hippodrome qui nous donne le lien des course de ce jour
Set tdhipo = document.getelementsbytagname("td")
For Each elem In tdhipo
If UCase(elem.innertext) = hippo Then lien1 = elem.Children(0).href: Exit For 'on a trouvé l'hippodrome !!!!!!!!!
Next
'************************************************************************************************************************************
'on réécrit le body avec le codehtml du lien1(courses dans cet hippodrome)
document.body.innerhtml = reponseREq(lien1) 'la dadans il y a toutes les course de cet hippodrome ce jour la
' on cherche la bonne course
Set tdprix = document.getelementsbytagname("a")
For Each elems In tdprix
If Trim(LCase(elems.innertext)) = Trim(nomprix) Then lien2 = elems.href: Exit For ' on a trouvé la bonne course!!!!!!!!!!
Next
'***************************************************************************************************
'on réécrit le body avec le codehtml du lien2( la course recherchée)
document.body.innerhtml = reponseREq(lien2)
If document.parentWindow.clipboardData.setData("Text", document.body.innerhtml) Then
Application.ScreenUpdating = False
'.parentWindow.clipboardData.clearData "Text"
End If
' A PARTIR DE LA ON PEUT RECUPERER LES TABLE DE GAINS
'Simple 'ZE couillon, 'Jumelé,'Trio,'Triordre,'ZE 2 sur 4,'ZE 4,'ZE 5,'ZE 234,'ZE 345
'bigpad center
For Each elem In document.all
If elem.classname = "bigpad center" Then
Select Case elem.Children(0).innertext
'************************************************************************************************************************************
Case "Simple"
'MsgBox elem.getelementsbytagname("table")(0).innertext
Set mestd = elem.getelementsbytagname("TD")
For Each td In mestd
If InStr(td.innertext, "") > 0 Then simplo = simplo & td.innertext & ","
Next
'MsgBox simplo
'************************************************************************************************************************************
Case "ZE couillon"
'MsgBox elem.getelementsbytagname("table")(0).innertext
Set mestd = elem.getelementsbytagname("TD")
For Each td In mestd
If InStr(td.innertext, "") > 0 Then ZEC = ZEC & td.innertext & ","
Next
' MsgBox ZEC
'************************************************************************************************************************************
Case "Jumelé"
'MsgBox elem.getelementsbytagname("table")(0).innertext
Set mestd = elem.getelementsbytagname("TD")
For Each td In mestd
If InStr(td.innertext, "") > 0 Then couplé = couplé & td.innertext & ","
Next
'MsgBox couplé
'************************************************************************************************************************************
Case "Trio"
'MsgBox elem.getelementsbytagname("table")(0).innertext
Set mestd = elem.getelementsbytagname("TD")
For Each td In mestd
If InStr(td.innertext, "") > 0 Then TRIo = TRIo & td.innertext & ","
Next
'MsgBox TRIo
'************************************************************************************************************************************
Case "Triordre"
'MsgBox elem.getelementsbytagname("table")(0).innertext
Set mestd = elem.getelementsbytagname("TD")
For Each td In mestd
If InStr(td.innertext, "") > 0 Then Triordre = Triordre & td.innertext & ","
Next
'MsgBox Triordre
'************************************************************************************************************************************
'ZE 2 sur 4
Case "ZE 2 sur 4"
'MsgBox elem.getelementsbytagname("table")(0).innertext
Set mestd = elem.getelementsbytagname("TD")
For Each td In mestd
If InStr(td.innertext, "") > 0 Then ZE24 = ZE24 & td.innertext & ",": Exit For
Next
'MsgBox ZE24
'************************************************************************************************************************************
'ZE 5
Case "ZE 5"
'MsgBox elem.getelementsbytagname("table")(0).innertext
Set mestd = elem.getelementsbytagname("TD")
For Each td In mestd
If InStr(td.innertext, "") > 0 Then ZE5 = ZE5 & td.innertext & ","
Next
'MsgBox ZE5
'************************************************************************************************************************************
'ZE234
Case "ZE 234"
'MsgBox elem.getelementsbytagname("table")(0).innertext
Set mestr = elem.getelementsbytagname("TR")
For i = 1 To mestr.Length - 1
If InStr(mestr(i).Children(2).innertext, "") > 0 Then ZE234 = ZE234 & mestr(i).Children(2).innertext & ","
If InStr(mestr(i).Children(3).innertext, "") > 0 Then ZE234B = ZE234B & mestr(i).Children(3).innertext & ","
Next
ZE234 = ZE234 & ZE234B
'************************************************************************************************************************************
Case "ZE 345"
'MsgBox elem.getelementsbytagname("table")(0).innertext
Set mestr = elem.getelementsbytagname("TR")
For i = 1 To mestr.Length - 1
If InStr(mestr(i).Children(2).innertext, "") > 0 Then ZE345 = ZE345 & mestr(i).Children(2).innertext & ","
If InStr(mestr(i).Children(3).innertext, "") > 0 Then ZE345B = ZE345B & mestr(i).Children(3).innertext & ","
Next
ZE345 = ZE345 & ZE345B
'************************************************************************************************************************************
End Select
End If
Next
raportzeturf = simplo & couplé & ZEC & TRIo & Triordre & ZE4 & ZE234 & ZE345
End Function
Sub test()
MsgBox raportzeturf("28/07/2015", "chantilly", "Prix du Bois Brandin")
End Sub
Sub test2()
MsgBox raportzeturf("30/07/2015", "DEAUVILLE", "Prix DE LA PLAINE DE CAEN")
End Sub |
Partager