Discussion :

[patricktoulon]

[speedturf]

je me suis mis sur microsoft edge

Pièce jointe 216377

[patricktoulon]

bon visiblement le F12 est le meme pour edgde et tu voit pas réseaux dans les onglet change de lunettes hein!!!!

ferme tout tes fichier excel
ouvre en un nouveau et met ceci dans un module standard

voila normalement avec cela tu devrait avoir sur ton bureau un fichier texte(" codesourcegeny.txt") avec le code source dedans
envoie moi ce fichier après

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
 
   Sub sauvegardecodesource()
fichier = "C:\Users\" & Environ("UserName") & "\Desktop\codesourcegeny.txt"
x = FreeFile
Open fichier For Output As #x
Print #x, datahtml("26/07/2016")
Close #x
End Sub

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
 
Function datahtml(Tdate)
    Dim ReQ, url As String
    url = "http://www.geny.com/reunions-courses-pmu/_d" & Format(Tdate, "yyyy-mm-dd") & "?"
    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

[speedturf]

je l'ai envoyé par skype

[patricktoulon]

ouais sauf que Skype c'est sur mon tel je n'en veux pas de Skype sur mon PC envoie le ici il n'y a rien de confidentiel

en regardant vite fait sur le tel il me viens une question
serait tu inscrit par hasard sur ce site ?????
si c'est le cas de mémorise tes login /MDP du site pour avoir la page public

[speedturf]

impossible d'effacer les autres et il me refuse l'envoie
bizarre

[patricktoulon]

non c'est pas bizarre mais normal selon le type de fichier il y a un poids limite je l'avais oublié
tu n' a qu'a le ziper tu sais faire???

voila le mien que j'obtiens tu pourrais déjà me dire si tu obtiens la même chose

[speedturf]

en regardant vite fait sur le tel il me viens une question
serait tu inscrit par hasard sur ce site ?????
si c'est le cas de mémorise tes login /MDP du site pour avoir la page public

de quel site tu parle

[patricktoulon]

heu........

on pale de geny il me semble depuis le début non?????

oulahh!!! ca fuse dans les neurones hein!!!

[speedturf]

codesourcegeny.rar

oui j'obtient la même chose

[patricktoulon]

ok je prends
je vais vérifier si tu n'a pas les outils les nuances peuvent passer inaperçues

[speedturf]

heu........

on pale de geny il me semble depuis le début non?????

oulahh!!! ca fuse dans les neurones hein!!!

oui, j'ai une inscription, exact

[patricktoulon]

ah!!! donc je suis dans le bon chemin delogue toi du site
car il est possible qu'il ai enregistré tes préférences etc......
il nous faut la page complète afin de pouvoir examiner le code générique
je reviens j'examine ton rar avec mes macros regex

Bon a priori a part les meta (header de page ) on est pareil sur les balises li il n'y a aucunes raison que tu n'obtienne pas la même chose que moi

sur ce point je n'ai pas encore d'explications je cherche

je vais modifier la macro afin de zapper cette confusion
je reviens

[speedturf]

merci pour ton aide

[patricktoulon]

bon voila on va faire comme cela fait tes test dans un fichier vierge a chaque fois ne pollue pas ton fichier original

dis moi si tu a bien les liens des stats de toutes les course et reunions

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Function datahtml(Tdate)
    Dim ReQ, url As String
    url = "http://www.geny.com/reunions-courses-pmu/_d" & Format(Tdate, "yyyy-mm-dd") & "?"
    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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
Sub recuplien_course_partant_stat()
Dim doc As Object, i As Long, meselem As Object, madate As String
Set doc = CreateObject("htmlfile") 'on créé un document html en memoire ( pas d'interface(fenetre))
madate = "26/07/2016"
With doc
.body.innerhtml = datahtml("26/07/2016") '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 Debug.Print "http://www.geny.com" & Replace(meselem(i).href, "about:", "")
Next
End With
End Sub

[speedturf]

rien ne s'affiche

[patricktoulon]

elle est ou ta fenêtre debug hein!..... tu l'a affiché au moins

[speedturf]

comment l'afficher ?

c'est bon, je ne l'avais pas ouvert

[patricktoulon]

[speedturf]

nos message se sont croiser