Create Object ("htmlfile")

Version imprimable

24/01/2016, 18h42
Sebphyto

Create Object ("htmlfile")
Bonjour à tous,

je viens vers vous car j'aimerai me connecter à un site avec login, password et 3 combox sur la page web jours/Mois/année
Je sais le faire avec un

Code:

CreateObject("InternetExplorer.Application")

Mais je ne sais pas commet procéder avec un

Code:

CreateObject("htmlfile")

je passe par une function
Code:

1 2 3 4 5 6 7 Public Function recupe_html(url) Dim REQ Set REQ = CreateObject("microsoft.xmlhttp") REQ.Open "POST", url, False REQ.send recupe_html = REQ.responseText End Function
Et dans la sub
Code:

1 2 3 4 With CreateObject("htmlfile") .write recupe_html(url) 'etc........ End With
merci d'avance pour votre aide
seb
24/01/2016, 22h24
patricktoulon

re

bonjour sebphyto

Citation:

Mais je ne sais pas commet procéder avec un

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

CreateObject("htmlfile")

la réponse est claire tu peut pas cet object est surtout fait pour travailler en local mais en aucun cas tu peut te loguer sur un site avec htmlfile

tu n'a pas beaucoup retenu hein!!!!:!

je vais taper sur les doigts ca va chauffer pour ton matricule
24/01/2016, 22h33
Sebphyto

1 pièce(s) jointe(s)

Mince mince et remince.....honte à moi :oops:

En fait je t'explique

comme tu le sais déjà, je récupère sur le web des informations, et je les consigne dans un "fauxdoc html", comme tu me l'as enseigné.
mais le souci c que depuis que j'ai dans ma procédure une connexion sécurisé via

Code:

CreateObject("InternetExplorer.Application")

, cela n'a peut-être pas de rapport, j'ai un message d'alerte à cette ligne que tu reconnaitras:

Code:

.body.innerHTML = doc2.body.innerHTML

Pièce jointe 198972
seb
24/01/2016, 22h37
patricktoulon

re

c'est normal si tu doit t'autentifier et meme si par requete c'est accepté cela se fait dans la requete pas dans le htmlfile
c'est quoi ce site????
25/01/2016, 09h29
Sebphyto
Salut Patrick,

Le site tu le connais par cœur...Ze.....

donc on doit pouvoir le faire dans la requête avec cette fonction, non???
Code:

1 2 3 4 5 6 7 Public Function recupe_html(url) Dim REQ Set REQ = CreateObject("microsoft.xmlhttp") REQ.Open "POST", url, False REQ.send recupe_html = REQ.responseText End Function
dans un sub j'ai
Code:

1 2 With CreateObject("htmlfile") .write recupe_html(url)
donc là, il va bien dans url.......Ah mais je crois que j'ai compris ce que tu voulais me dire....il faut que l'url ici, soit déjà l'url authentifié ....dit moi si je me trompe
En faite j'ai juste besoin de m'authentifier une seule fois pour récupérer un lien

seb
25/01/2016, 09h33
patricktoulon

re

Bonjour seb

si c'est le lien que je crois c'est foutu car ils l'on bloqué en post et get les requete ne sont pas autorisées

si c'est pas le lien que je crois donne j'irais voir si c'est possible
25/01/2016, 09h50
Sebphyto

re,

C dans la partie pro du site
Ici
Mais cà doit être celui-là, car sous forme de get/post, je n'arrive pas à récupérer ce que je veux, le .geteelementsby reste vide.

Parcontre j'arrive à tout récupérer avec du createObject "(internetexplorer.Application)"

Alors la question serai est-il possible une fois mais récup faite de les transférer dans un fauxdoc
seb
Edit:
je reviens sur ce que j'ai dit
En faite le recupe_html = REQ.responseText, debug sur REQ.responseText, est bien complet il y a toutes les infos que je veux

OK!!! c'est possible
change ce qui est en couleur
le 57 represent le nombre de lettre -1 que represente l'argument du send il faut que tu mette ce qui corespond au tien

Code:

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
Public Function recupe_html()
    Dim REQ
    Set REQ = CreateObject("microsoft.xmlhttp")
    REQ.Open "POST", "http://www.zeturf.fr/fr/accueil/", False
    REQ.SetRequestHeader "Accept", " text/html, application/xhtml+xml, */*"
    REQ.SetRequestHeader "Referer", "http://www.zeturf.fr/fr/accueil/"
    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 "Content-Type", "application/x-www-form-urlencoded"
    REQ.SetRequestHeader "Accept-Encoding", "gzip, deflate"
    REQ.SetRequestHeader "Host", "www.zeturf.fr"
    REQ.SetRequestHeader "Content-Length", "57"    'ici cela doit corespondre au nombre de lettre representant l'argument du sent
    REQ.SetRequestHeader "DNT", "1"
    REQ.SetRequestHeader "Connection", "Keep - Alive"
    REQ.SetRequestHeader "Cache-Control", "no-cache"

'exemple d' argument du send= login=toto&password=cocoricoco&jour=04&mois=04&annee=1972
   
 REQ.send "login=toto&password=cocoricoco&jour=04&mois=04&annee=1972"
    recupe_html = REQ.responseText
End Function

Sub test()
    MsgBox recupe_html
End Sub

service de depanage vba html expres bonjour que désirez vous ?:lol:

et pour ton lien PRO
c'est

Code:

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
Sub test2()
url = "https://pro.zeturf.com/externe/zefiche_cheval_.php?hippodrome=VINCENNES&dr=20160122&nr=4&nc=1&nch=1&"
With CreateObject("htmlfile")
If .parentWindow.clipboardData.setData("Text", recupe_html(url)) Then
            Application.ScreenUpdating = False
            With Sheets(1)
                .Activate
                .Cells(1, 1).Select
                .Paste
            End With
            .parentWindow.clipboardData.clearData "Text"
        End If
End With
End Sub
Public Function recupe_html(url)
    Dim REQ
    Set REQ = CreateObject("microsoft.xmlhttp")
    REQ.Open "POST", url, False
   
    'headzer de la requete !!!!!!!!!!!!!!!!!!!
    REQ.SetRequestHeader "Accept", " text/html, application/xhtml+xml, */*"
    REQ.SetRequestHeader "Referer", "http://www.zeturf.fr/fr/accueil/"
    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 "Content-Type", "application/x-www-form-urlencoded"
    REQ.SetRequestHeader "Accept-Encoding", "gzip, deflate"
    REQ.SetRequestHeader "Host", "www.zeturf.fr"
      
    REQ.SetRequestHeader "DNT", "1"
    REQ.SetRequestHeader "Connection", "Keep - Alive"
    REQ.SetRequestHeader "Cache-Control", "no-cache"
    'fin du header de la requete !!!!!!!!!!!!!!!
    REQ.send
    recupe_html = REQ.responseText
End Function

purré tu devrais savoir maintenant que ces sites exigent des requetes conformes quand ils en autorisent l utilisation
le header de la requete est obligatoire non de dieu tu retiens rien arete les huiles essentielles :ptdr:
autre chose?????:ptdr:

25/01/2016, 10h13
Sebphyto

Toujours aussi efficace mon bon Patrick
Je teste et te redit
seb
25/01/2016, 10h34
patricktoulon

re

j'ai deja testé :ptdr:

j'essai de l'arranger en trafiquant dans le code html pour les td qui sont large arrivé dans le sheets mais tout y est
25/01/2016, 11h06
Sebphyto

Pour info,
Avec tes réponses que tu m'as apporté, mon code fonctionne parfaitement, ainsi que la rapidité qui c'est fortement améliorée....
J'ai pas encore testé les 2 codes du dessus, je re
seb

C'est bon pour moi, magnifique encore une fois...Merci pour ta connaissance Patrick..
Seb

tiens teste celui la
nikel rangé et rapide en en couleur

Code:

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
Sub test2()
    Dim tablo(10)
    url = "https://pro.zeturf.com/externe/zefiche_cheval_.php?hippodrome=VINCENNES&dr=20160122&nr=4&nc=1&nch=1&"
    With CreateObject("htmlfile")
        If .parentWindow.clipboardData.setData("Text", recupe_html(url)) Then
            Application.ScreenUpdating = False
            With Sheets(1)
                .Activate
                .Cells(1, 1).Select
                .Paste
                For Each sh In .Shapes
                    sh.Delete
                Next
                .Cells.UnMerge
                Set c = Cells.Find("Cheval", LookIn:=xlValues)
                If Not c Is Nothing Then
                    firstAddress = c.Address
                    Do
                        tablo(r) = c.Address & ":" & c.Offset(7, 6).Address
                        Set c = Cells.FindNext(c)
                        r = r + 1
                    Loop While Not c Is Nothing And c.Address <> firstAddress
                End If
                For r = 0 To UBound(tablo)
                    If tablo(r) <> "" Then
                        Range(tablo(r)).Copy Destination:=Range("B" & Range(tablo(r)).Row)
                    End If
                Next
                .Columns("H:AL").Clear
                For Each cel In .Range("A1:A300").Cells
                    If Len(cel.Value) > 40 Then Range(cel, cel.Offset(0, 10)).MergeCells = True
                Next
            End With
            .parentWindow.clipboardData.clearData "Text"
        End If
    End With
End Sub

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Public Function recupe_html(url)
    Dim REQ
    Set REQ = CreateObject("microsoft.xmlhttp")
    REQ.Open "POST", url, False
    REQ.SetRequestHeader "Accept", " text/html, application/xhtml+xml, */*"
    REQ.SetRequestHeader "Referer", "http://www.zeturf.fr/fr/accueil/"
    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 "Content-Type", "application/x-www-form-urlencoded"
    REQ.SetRequestHeader "Accept-Encoding", "gzip, deflate"
    REQ.SetRequestHeader "Host", "www.zeturf.fr"
    REQ.SetRequestHeader "DNT", "1"
    REQ.SetRequestHeader "Connection", "Keep - Alive"
    REQ.SetRequestHeader "Cache-Control", "no-cache"
    REQ.send
    recupe_html = REQ.responseText
End Function

c'est classe non!?

25/01/2016, 12h00
Sebphyto

Tu me montres encore que j'ai besoin de grandir dans le domaine ;)

Belle perf encore une fois

Merci pour ce que tu apportes
seb
25/01/2016, 22h23
patricktoulon

re

ho je pense que les bases maintenant tu les a mais c'est les nuances qui te font encore defaut

mais surtout il faut deja savoir le resultat final souhaité
tu travaille encore au jour le jour comme on dit chez nous

tu vois demain ,je vois la semaine prochaine

C encouragent ce que tu dis merci...

J'ai une question
Pourrai-tu me dire où je peux trouver les différentes propriétés CSS appliqué au VBA (tuto par ex, ou liens), car je ne trouve pas grand chose sur le WEB....???
Comme tu sais si bien le faire

Ex:
Code:

1 2 3 4 With elemtd '.Style.borderTop = 1 & "px solid #000000 " '.Style.borderBottom = 1 & "px solid #000000 " .Style.textAlign = "center"

26/01/2016, 00h55
patricktoulon

re

re
je te ferait un petit lexique tu trouve ca nulpart

cela dit c'est toujours precedé par style.

elem.style.baground="#ffffff" ' = background color blanc
elem.style.color ="#fffff" = font color blanc
elem.style.borderbotton="1 px solid #fffffff" bordure basse blache de 1 pixel d'epaisseur
ala place de bottom c'est top left right pour les autre coté

on peu aussi fair elem.border= "1px solid #fffff" ' toute les bordures blanche
solid c'est le style

dashed c'est tiret en point iilets
dotted c'es pointillet

pour les td aussi il y a les fusion c'est colspan pour les colonne et rowspan pour les ligne mais sans style (td.colspan=2) fusion sur 2 colonne et une seul ligne

pour la police c'est .style.fontfamily
il y a aussi fontstyle pour italic etc....

bref il y en a plein et j'en decouvre encore

vb s'ameliore

je vois que maintenant tu t'ataque au style dans un htmlfile c'est ca ?

bon allez je vais me coucher je suis crevé
26/01/2016, 00h58
Sebphyto

C' exactement ça, j'avance doucement

En me basant sur une formation Html et CSS que j'ai ....cela se rapproche beaucoup....j'étudie
Bonne nuit
seb