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
| Dim liste
Function datahtml(url)
Dim ReQ
Set ReQ = CreateObject("microsoft.xmlhttp")
With ReQ
.Open "GET", url, False
.setrequestheader "Accept", "text/html, application/xhtml+xml, */*"
.setrequestheader "Accept-Language", "fr-FR"
.setrequestheader "User-Agent", "Mozilla/5.0 (Windows NT 6.1; WOW64; Trident/7.0; rv:11.0) like Gecko"
.setrequestheader "Accept-Encoding", "gzip, deflate"
.setrequestheader "Host", "www.geny.com"
.setrequestheader "Connection", "Keep - Alive"
.setrequestheader "cache-Control", " no-cache"
.send
'Debug.Print .responsetext
datahtml = .responsetext
End With
End Function
'http://www.geny.com/reunions-courses-pmu/_d2016-07-26?
'exemple de lien page prono='http://www.geny.com/partants-pmu/2016-07-26-vichy-pmu-prix-du-golf-du-sporting-de-vichy_c824673
Public Function liste_page_stat(madate As String) As Variant
Dim doc As Object, i As Long, meselem As Object, url As String, list(900)
Set doc = CreateObject("htmlfile") 'on créé un document html en memoire ( pas d'interface(fenetre))
url = "http://www.geny.com/reunions-courses-pmu/_d" & Format(madate, "yyyy-mm-dd") & "?"
With doc
.body.innerhtml = datahtml(url) 'on met dans son body le resultat de la fonction datahtml
'on va rechercher les bouton coursepartantsstat
Set meselem = .getelementsbytagname("a") ' on collectionne toutes les balises"<a></a>"
For i = 0 To meselem.Length - 1
If meselem(i).href Like "*partants-pmu/" & Year(madate) & "*" Then
texte = texte & vbCrLf & "http://www.geny.com" & Replace(meselem(i).href, "about:", "")
End If
Next
End With
liste_page_stat = texte
End Function
Sub test()
Sheets(1).Cells.Clear
Dim madate As String
madate = "26/07/2016"
liste = Split(liste_page_stat(madate), vbCrLf)
For i = 0 To UBound(liste)
If liste(i) <> "" Then
'dt_partants
With CreateObject("htmlfile")
.body.innerhtml = datahtml(liste(i))
.body.innerhtml = .getelementbyid("dt_partants").getelementsbytagname("table")(0).outerhtml
If .parentWindow.clipboardData.setData("Text", .body.innerhtml) Then
Application.ScreenUpdating = False
With Sheets(1)
.Activate
With .Cells(Rows.Count, 1).End(xlUp).Offset(2, 0)
.Value = liste(i)
.Offset(1, 0).Select
End With
.Paste
End With
.parentWindow.clipboardData.clearData "Text"
End If
End With
End If
Next
End Sub |
Partager