Piloter la fenetre windows en vba

**patricktoulon** · 21/06/2016, 18h03

chez moi toute les lignes de l'argu sont obligatoires

après oui les header de requête sont parfois facultatifs et fonctionne meme sans , mais je les mets quand même par ce que les sites n'aimes pas trop les requêtes tronquées et vu que le site propose lui même une api a 75 € ca me parait indispensable de ne pas les contrarier

ensuite j'aimerais pour le fun jouer encore avec mes tablo en string facon Marc mais je ne pige pas j'y arrive pas

sub de teste

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
Sub testTabstring()
    Dim ISIN, texte, tablo, lig
    ISIN = "FR0000031122"
    texte = requete(ISIN)
'Debug.Print texte
'************************************************tablo en string********************************************
lig = UBound(Split(texte, vbCrLf))
texte = Replace(Replace(texte, ";", ","), vbCrLf, ";")
Debug.Print texte  ' on peu voir la chaine formater dans le debug 
tablo = Evaluate("[" & texte & "]")
Sheets(1).Cells(2, 1).Resize(lig, 7) = Application.Transpose(tablo)
End Sub

j'ai #VALEUR!! dans toutes les cellules

hallo!!!! Marc ou es tu !!!???

**patricktoulon** · 21/06/2016, 18h19

voila j'ai mis aussi la date deb et fin en dynamique
c'est a partir de evaluate que ca ne marche pas

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
Sub testTabstring()
    Dim ISIN, texte, tablo, lig, datedeb As String, datefin As String
    ISIN = "FR0000031122"
    datedeb = "20/06/2015"
    datefin = "20/06/2016"
    texte = requete(ISIN, datedeb, datefin)
    Debug.Print texte
    '************************************************tablo en string********************************************
 
    lig = UBound(Split(texte, vbCrLf))
    texte = Replace(Replace(texte, ";", ","), vbCrLf, ";")
    Debug.Print texte
    tablo = Evaluate("[" & texte & "]")
    Sheets(1).Cells(2, 1).Resize(lig, 7) = Application.Transpose(tablo)
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 requete(ISIN, datedeb, datefin)
    Dim Req, url
    url = "http://www.abcbourse.com/download/historiques.aspx"
    Set Req = CreateObject("microsoft.xmlhttp")
    With Req
        .Open "get", url, False
        .SetRequestHeader "Accept", "text/html, application/xhtml+xml, */*"
        .SetRequestHeader "Referer", "http://www.abcbourse.com/download/historiques.aspx"
        .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 "Content-Type", "application/x-www-form-urlencoded"
        .SetRequestHeader "Accept-Encoding", "gzip, deflate"
        .SetRequestHeader "Host", "www.abcbourse.com"
        .SetRequestHeader "Connection", "Keep - Alive"
        .SetRequestHeader "Cache-Control", "no-cache"
        .send argu(ISIN, datedeb, datefin)
        requete = Replace(.responsetext, ",", ".")
    End With
End Function

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
20
21
22
23
24
25
26
27
28
29
Function argu(ISIN, datedeb, datefin) As String
    argmt = "ctl00_BodyABC_ToolkitScriptManager1_HiddenField=%3B%3BAjaxControlToolkit%2C+Version%3D3.0.20229.20843%2C+Culture%3Dneutral%2C+PublicKeyToken%3D28f01b0e84b6d53e%3"
    argmt = argmt & "Afr-FR%3A3b7d1b28-161f-426a-ab77-b345f2c428f5%3A865923e8%3A9b7907bc%3A411fea1c%3Ae7c87f07%3A91bd373d%3Abbfda34c%3A30a78ec5%3A9349f837%3Ad4245214%3"
    argmt = argmt & "A8e72a662%3Aacd642d2%3A596d588c%3A77c58d20%3A14b56adc%3A269a19ae&__EVENTTARGET=&__EVENTARGUMENT=&__VIEWSTATE=%2FwEPDwUIMzcyNDY5MjIPZBYCZg9"
    argmt = argmt & "kFgICBA9kFgQCCw9kFgJmDxYCHgdWaXNpYmxlZ2QCDQ9kFgICAQ8PFgIeBFRleHQFKUJhc2N1bGVyIHN1ciBsYSB2ZXJzaW9uIGNsYXNzaXF1ZSBkdSBzaXRlZGQYAQUeX19Db250cm9sc1Jlc"
    argmt = argmt & "XVpcmVQb3N0QmFja0tleV9fFisFFmN0bDAwJEJvZHlBQkMkZXVyb2xpc3QFHGN0bDAwJEJvZHlBQkMkYWN0aW9uc2luZGljZXMFGmN0bDAwJEJvZHlBQkMkYWN0aW9uc2luZHVzBRVjd"
    argmt = argmt & "GwwMCRCb2R5QUJDJGNvbXBsZXQFG2N0bDAwJEJvZHlBQkMkY29tcGxldG5vd2FycgUSY3RsMDAkQm9keUFCQyRzcmRwBRhjdGwwMCRCb2R5QUJDJGluZGljZXNta3AFGWN0bDAwJEJ"
    argmt = argmt & "vZHlBQkMkaW5kaWNlc3NlY3AFGGN0bDAwJEJvZHlBQkMkZXVyb2xpc3RhcAUYY3RsMDAkQm9keUFCQyRldXJvbGlzdGJwBRhjdGwwMCRCb2R5QUJDJGV1cm9saXN0Y3AFGWN0bDAwJE"
    argmt = argmt & "JvZHlBQkMkZXVyb2xpc3R6ZXAFFGN0bDAwJEJvZHlBQkMkYWx0ZXJwBRFjdGwwMCRCb2R5QUJDJG1scAUUY3RsMDAkQm9keUFCQyR0cmFja3AFEWN0bDAwJEJvZHlBQkMkYnNwBRNjdG"
    argmt = argmt & "wwMCRCb2R5QUJDJG9ibDJwBRJjdGwwMCRCb2R5QUJDJG9ibHAFFmN0bDAwJEJvZHlBQkMkd2FycmFudHMFF2N0bDAwJEJvZHlBQkMkb3Bjdm0zNjBwBRVjdGwwMCRCb2R5QUJDJHhjY"
    argmt = argmt & "WM0MHAFFmN0bDAwJEJvZHlBQkMkeHNiZjEyMHAFFWN0bDAwJEJvZHlBQkMkeGNhY2F0cAUWY3RsMDAkQm9keUFCQyR4Y2FjbjIwcAUYY3RsMDAkQm9keUFCQyR4Y2Fjc21hbGxwBRV"
    argmt = argmt & "jdGwwMCRCb2R5QUJDJHhjYWM2MHAFFmN0bDAwJEJvZHlBQkMkeGNhY2w2MHAFFWN0bDAwJEJvZHlBQkMkeGNhY21zcAUVY3RsMDAkQm9keUFCQyR4YmVsMjBnBRVjdGwwMCRCb"
    argmt = argmt & "2R5QUJDJHhhZXgyNW4FEWN0bDAwJEJvZHlBQkMkZGp1BRJjdGwwMCRCb2R5QUJDJG5hc3UFFGN0bDAwJEJvZHlBQkMkc3A1MDB1BRZjdGwwMCRCb2R5QUJDJGdlcm1hbnlmBRJjdGww"
    argmt = argmt & "MCRCb2R5QUJDJHVzYXUFEWN0bDAwJEJvZHlBQkMkdWtlBRJjdGwwMCRCb2R5QUJDJGJlbGcFE2N0bDAwJEJvZHlBQkMkaG9sbG4FFWN0bDAwJEJvZHlBQkMkaXRhbGlhaQUVY3RsMDAkQ"
    argmt = argmt & "m9keUFCQyRsaXNib2FsBRJjdGwwMCRCb2R5QUJDJGRldnAFFWN0bDAwJEJvZHlBQkMkb25lU2ljbwUTY3RsMDAkQm9keUFCQyRjYlllc0QdAEFMOzMYfTefgBBJ2ZEUaWDk&__VIEWSTATEGE"
    argmt = argmt & "NERATOR=0EFFD687&__EVENTVALIDATION=%2FwEdADzeU%2B461dgjKeOy4euPx9%2BA2AGy%2BFRpYOz7XDkkbfjubp9UXI7RwI%2BukRHnd%2BAlDZ4TidDdlkpo2nU8toG3jbaiO3bQR4gY"
    argmt = argmt & "jmmwS4y4ybsn33KxLZyHhf4Mje%2Fl2WxsZO8oboymX8K%2FawfpAYdrARkboi8y0D1aKa8YRDbuZk9hCVB%2BkE3gZYtipUze3jzNDNCMEBEMWFEOc%2BNHEbSbw8FvNFYdXyAUuxt6%2B0jb"
    argmt = argmt & "Zc5Nwm1GD0QooTm97LUU9GUKpnIOC%2Bu%2F2W%2BuWyGuXN02UbCiJJxmjp5mkW8DeM%2FocI5W8WmvXMDKwmYrvBKC7pnWUAtWcpMoVsSmOCOdnlXIcoXu%2F%2Baf%2FiQDbqN"
    argmt = argmt & "tvcnRfkH2oiyB7RsbMXUq2lzc8dt95PPQBi3yzHLNr8sNaxE4jXoUvkYLOMZtGPFq8wOue%2BL3aL6QIV9VrUyAORU3dPeNj8oSuxs4fVNVenj9bBwNMtd92XoZ0fgAFx0VYRpgUubx6aGZq7pW4kA"
    argmt = argmt & "u5m8fb5ci0zgmhY9T9Z7NZO7Gj9tArTr%2B8hOKHkjEHKgE6Cl%2BPlWP6CsBz2dyy933VqldEv71pnrWB5fl7SDH6%2BLCeR6Cj3hBml1ipBDbFFYwrN937W%2FpOlYevFxpTuQO4S87Jds5qM1Ryr"
    argmt = argmt & "Z1RzKjY7kpf1Uy1EsRjq0lzGo3UDCLR8Qzg%2BICOaGQP60Muea7Jt2Mvrk5dP50a3x3ndE82QKf%2FstnRZsbrDvGsRZUo73a6kgCRfaABEjb6VehtduCyrNNbiEE%2Fszy7cIA2%2BGZ1fAM4FpZyQ0"
    argmt = argmt & "JQYbnRAQISh2SLDGw6kCjm8bengUhKB5UkNIenkLIxtz0C366YLNhLa4%2Bher91UkHVTURjwLX%2FQYZkMXRVY7ahhNyymD9AkgSjvLPgJHTftqgsr%2FG5iTF4NQnaPIQKG4JEjJG69LLH4QzaePL67"
    argmt = argmt & "dWk8ZNAzb5On4rHEP9HywghYG2IhWARgjMSGRv0qVhmbJ7tKAZQEwZOXR5bkA%2FrAjwH8gVCsdxCsXo10tHBh3HveAa6n1yqBv3gW0GFevOJ3B1BYZY9YGcYkXPO5BP5Glxc6DgHBR%2FbLiuAO"
    argmt = argmt & "ggKUrocUhDbgaIk74hDc4yWeNpVf1illXfalS4IP%2F8sbnyzuXvAG8jxH5CKE3kDDjxbgu9dzc8bjDscnPAvX10CapGgKKLX%2FbunaysEeSBMg0k95D%2Fr74nIW2lQs5QGOEcyRrWx3np81%2BkE7Z2rp"
    argmt = argmt & "WliSuX9l6PQze7UQLbQ7Ri0FTVMSOPzduwVGJIAMkEhBJFgSlik%2FmRQFFRqx4FrCPfzOVdZTJAQMVyjQ%3D%3D&ctl00%24txtAutoComplete=&ctl00%24BodyABC%24strDateDeb=" & Replace(datedeb, "/", "%2F")
    argmt = argmt & "&ctl00%24BodyABC%24strDateFin=" & Replace(datefin, "/", "%2F") & "&ctl00%24BodyABC%24oneSico=on&ctl00%24BodyABC%24txtOneSico=" & ISIN & " &ctl00%24BodyABC%24Button1=T%C3%A9l%"
    argmt = argmt & "C3%A9charger&ctl00%24BodyABC%24dlFormat=x&ctl00%24BodyABC%24listFormat=isin"
    argu = argmt
End Function

**davido84** · 21/06/2016, 18h37

Je ne comprends pas pourquoi tu utilises un Evaluate alors qu'il te suffit de Spliter le ResponseText puis d'utiliser TextToColumns pour répartir les données dans la feuille.
A+

**patricktoulon** · 21/06/2016, 19h53

pour le fun et pour pouvoir utiliser une variable tableau pour travailler dessus en dehors d'Excel

sinon j'ai une autre solution "le htmlfile"

n je fait tout avec ca même la vaiselle

**davido84** · 21/06/2016, 21h08

On peut éventuellement prévoir un test au cas où les paramètres de la requête ne ramèneraient aucun résultat (dans ce cas c'est le document html de la page qui est retourné et non les valeurs boursières) :

Code :

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

If InStr(.responseText, "</html>") > 0 Then MsgBox "Vérifiez les paramètres de la requête": Exit Sub

La procédure complète (à tester sur le fichier du message précédent) devient donc :

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
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
Sub XmlHttpReq_abcbourse()    
Const URL = "http://www.abcbourse.com/download/historiques.aspx"
    Dim S() As String, T As String
    Dim DateDebut As Date, DateFin As Date, sIsin As String, Ti As Single
    Dim oXmlHttp As XmlHttp
 
    Ti = Timer
 
    DateDebut = Range("Date_debut").Value
    DateFin = Range("Date_fin").Value
    sIsin = Range("Isin").Value
 
Set oXmlHttp = New XmlHttp
 
'------------------------------------------- CORPS DE LA REQUETE ---------------------------------
 'facultatif
 T = "ctl00_BodyABC_ToolkitScriptManager1_HiddenField=%3B%3BAjaxControlToolkit%2C+Version%3D3.0.20229.20843%2C+Culture%3Dneutral%2C+"
 T = T & "PublicKeyToken%3D28f01b0e84b6d53e%3Afr-FR%3A3b7d1b28-161f-426a-ab77-b345f2c428f5%3A865923e8%3A9b7907bc%3A411fea1c%3Ae7c87f07%3A91bd373d"
 T = T & "%3Abbfda34c%3A30a78ec5%3A9349f837%3Ad4245214%3A8e72a662%3Aacd642d2%3A596d588c%3A77c58d20%3A14b56adc%3A269a19ae&"
 
 T = T & "__EVENTTARGET=&" 'facultatif
 
 T = T & "__EVENTARGUMENT=&" 'facultatif
 
 T = T & "__VIEWSTATE=%2FwEPDwUIMzcyNDY5MjIPZBYCZg9kFgICBA9kFgQCCw9kFgJmDxYCHgdWaXNpYmxlZ2QCDQ9kFgICAQ8PFgIeBFRleHQ"
 T = T & "FKUJhc2N1bGVyIHN1ciBsYSB2ZXJzaW9uIGNsYXNzaXF1ZSBkdSBzaXRlZGQYAQUeX19Db250cm9sc1JlcXVpcmVQb3N0QmFja0tleV9fFisFFmN0bDAwJEJvZHlBQkMkZXVy"
 T = T & "b2xpc3QFHGN0bDAwJEJvZHlBQkMkYWN0aW9uc2luZGljZXMFGmN0bDAwJEJvZHlBQkMkYWN0aW9uc2luZHVzBRVjdGwwMCRCb2R5QUJDJGNvbXBsZXQFG2N0bDAwJEJvZHlBQk"
 T = T & "MkY29tcGxldG5vd2FycgUSY3RsMDAkQm9keUFCQyRzcmRwBRhjdGwwMCRCb2R5QUJDJGluZGljZXNta3AFGWN0bDAwJEJvZHlBQkMkaW5kaWNlc3NlY3AFGGN0bDAwJEJvZHlBQk"
 T = T & "MkZXVyb2xpc3RhcAUYY3RsMDAkQm9keUFCQyRldXJvbGlzdGJwBRhjdGwwMCRCb2R5QUJDJGV1cm9saXN0Y3AFGWN0bDAwJEJvZHlBQkMkZXVyb2xpc3R6ZXAFFGN0bDAwJEJv"
 T = T & "ZHlBQkMkYWx0ZXJwBRFjdGwwMCRCb2R5QUJDJG1scAUUY3RsMDAkQm9keUFCQyR0cmFja3AFEWN0bDAwJEJvZHlBQkMkYnNwBRNjdGwwMCRCb2R5QUJDJG9ibDJwBRJjdGwwMCRCb"
 T = T & "2R5QUJDJG9ibHAFFmN0bDAwJEJvZHlBQkMkd2FycmFudHMFF2N0bDAwJEJvZHlBQkMkb3Bjdm0zNjBwBRVjdGwwMCRCb2R5QUJDJHhjYWM0MHAFFmN0bDAwJEJvZHlBQkMkeHNiZj"
 T = T & "EyMHAFFWN0bDAwJEJvZHlBQkMkeGNhY2F0cAUWY3RsMDAkQm9keUFCQyR4Y2FjbjIwcAUYY3RsMDAkQm9keUFCQyR4Y2Fjc21hbGxwBRVjdGwwMCRCb2R5QUJDJHhjYWM2MHAFF"
 T = T & "mN0bDAwJEJvZHlBQkMkeGNhY2w2MHAFFWN0bDAwJEJvZHlBQkMkeGNhY21zcAUVY3RsMDAkQm9keUFCQyR4YmVsMjBnBRVjdGwwMCRCb2R5QUJDJHhhZXgyNW4FEWN0bDAwJEJvZH"
 T = T & "lBQkMkZGp1BRJjdGwwMCRCb2R5QUJDJG5hc3UFFGN0bDAwJEJvZHlBQkMkc3A1MDB1BRZjdGwwMCRCb2R5QUJDJGdlcm1hbnlmBRJjdGwwMCRCb2R5QUJDJHVzYXUFEWN0bDAwJEJ"
 T = T & "vZHlBQkMkdWtlBRJjdGwwMCRCb2R5QUJDJGJlbGcFE2N0bDAwJEJvZHlBQkMkaG9sbG4FFWN0bDAwJEJvZHlBQkMkaXRhbGlhaQUVY3RsMDAkQm9keUFCQyRsaXNib2FsBRJjd"
 T = T & "GwwMCRCb2R5QUJDJGRldnAFFWN0bDAwJEJvZHlBQkMkb25lU2ljbwUTY3RsMDAkQm9keUFCQyRjYlllc0QdAEFMOzMYfTefgBBJ2ZEUaWDk&"
 
 T = T & "__VIEWSTATEGENERATOR=0EFFD687&" 'facultatif
 
 T = T & "__EVENTVALIDATION=%2FwEdADzeU%2B461dgjKeOy4euPx9%2BA2AGy%2BFRpYOz7XDkkbfjubp9UXI7RwI%2BukRHnd%2BAlDZ4TidDd"
 T = T & "lkpo2nU8toG3jbaiO3bQR4gYjmmwS4y4ybsn33KxLZyHhf4Mje%2Fl2WxsZO8oboymX8K%2FawfpAYdrARkboi8y0D1aKa8YRDbuZk9hCVB%2BkE3gZYtipUze3jzNDNCMEBEMWFEO"
 T = T & "c%2BNHEbSbw8FvNFYdXyAUuxt6%2B0jbZc5Nwm1GD0QooTm97LUU9GUKpnIOC%2Bu%2F2W%2BuWyGuXN02UbCiJJxmjp5mkW8DeM%2FocI5W8WmvXMDKwmYrvBKC7pnWUAtWcpMo"
 T = T & "VsSmOCOdnlXIcoXu%2F%2Baf%2FiQDbqNtvcnRfkH2oiyB7RsbMXUq2lzc8dt95PPQBi3yzHLNr8sNaxE4jXoUvkYLOMZtGPFq8wOue%2BL3aL6QIV9VrUyAORU3dPeNj8oSuxs4f"
 T = T & "VNVenj9bBwNMtd92XoZ0fgAFx0VYRpgUubx6aGZq7pW4kAu5m8fb5ci0zgmhY9T9Z7NZO7Gj9tArTr%2B8hOKHkjEHKgE6Cl%2BPlWP6CsBz2dyy933VqldEv71pnrWB5fl7SDH"
 T = T & "6%2BLCeR6Cj3hBml1ipBDbFFYwrN937W%2FpOlYevFxpTuQO4S87Jds5qM1RyrZ1RzKjY7kpf1Uy1EsRjq0lzGo3UDCLR8Qzg%2BICOaGQP60Muea7Jt2Mvrk5dP50a3x3ndE82QK"
 T = T & "f%2FstnRZsbrDvGsRZUo73a6kgCRfaABEjb6VehtduCyrNNbiEE%2Fszy7cIA2%2BGZ1fAM4FpZyQ0JQYbnRAQISh2SLDGw6kCjm8bengUhKB5UkNIenkLIxtz0C366YLNhLa"
 T = T & "4%2Bher91UkHVTURjwLX%2FQYZkMXRVY7ahhNyymD9AkgSjvLPgJHTftqgsr%2FG5iTF4NQnaPIQKG4JEjJG69LLH4QzaePL67dWk8ZNAzb5On4rHEP9HywghYG2IhWARgjMSGRv"
 T = T & "0qVhmbJ7tKAZQEwZOXR5bkA%2FrAjwH8gVCsdxCsXo10tHBh3HveAa6n1yqBv3gW0GFevOJ3B1BYZY9YGcYkXPO5BP5Glxc6DgHBR%2FbLiuAOggKUrocUhDbgaIk74hDc4yWeNpVf"
 T = T & "1illXfalS4IP%2F8sbnyzuXvAG8jxH5CKE3kDDjxbgu9dzc8bjDscnPAvX10CapGgKKLX%2FbunaysEeSBMg0k95D%2Fr74nIW2lQs5QGOEcyRrWx3np81%2BkE7Z2rpWliSuX9"
 T = T & "l6PQze7UQLbQ7Ri0FTVMSOPzduwVGJIAMkEhBJFgSlik%2FmRQFFRqx4FrCPfzOVdZTJAQMVyjQ%3D%3D&"
 
 T = T & "ctl00%24txtAutoComplete=&" 'facultatif
 
 T = T & "ctl00%24BodyABC%24strDateDeb=" & Replace(DateDebut, "/", "%2F") & "&" 'date de début
 T = T & "ctl00%24BodyABC%24strDateFin=" & Replace(DateFin, "/", "%2F") & "&" 'date de fin
 T = T & "ctl00%24BodyABC%24oneSico=on&" 'coche ISIN activée
 T = T & "ctl00%24BodyABC%24txtOneSico=" & sIsin & "&" 'valeur de l'ISIN
 T = T & "ctl00%24BodyABC%24Button1=T%C3%A9l%C3%A9charger&" 'activer le téléchargement
 T = T & "ctl00%24BodyABC%24dlFormat=x&" 'liste des formats : Excel sélectionné
 T = T & "ctl00%24BodyABC%24listFormat=isin" 'liste des codes : ISIN sélectionné
'--------------------------------------------------------------------------------------------------------
 
    With oXmlHttp
        .Open "POST", URL, False
'--------------------------------------- Entêtes dans IE ------------------------------------------------
'        .setRequestHeader "Accept", "text/html, application/xhtml+xml, image/jxr, */*"
'        .setRequestHeader "Accept-Encoding", "gzip, deflate"
'        .setRequestHeader "Accept-Language", "fr-FR, fr; q=0.8, en-US; q=0.5, en; q=0.3"
'        .setRequestHeader "Cache-Control", "no-cache"
'        .setRequestHeader "Connection", "keep-alive"
'        .setRequestHeader "Content-Length", "3708"
        .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
'        .setRequestHeader "Cookie", "_ga=GA1.2.338785583.1464694728; __gads=ID=f06fd70b31924236:T=1464694747:S=ALNI_MYUr2IL9dK0mR0lYx403g1V5yJ47g; _gat=1; ASP.NET_SessionId=o032rswcsaxvmrsccqfmx2oo; axd=100057101507360010"
'        .setRequestHeader "Host", "www.abcbourse.com"
'        .setRequestHeader "Referer", "http://www.abcbourse.com/download/historiques.aspx"
'        .setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/46.0.2486.0 Safari/537.36 Edge/13.10586"
 
        On Error Resume Next
 
        .send T
 
        If .readyState = 4 Then
          If .Status <> 200 Then MsgBox "Erreur de connexion !": Exit Sub
          On Error GoTo 0
 
          'Debug.Print .responseText
          'si la requête ne ramène pas de résultat c'est le document html de la page qui est ramené
          If InStr(.responseText, "</html>") > 0 Then MsgBox "Vérifiez les paramètres de la requête": Exit Sub
          S = Split(.responseText, vbCrLf)
 
          With Sheets("abcbourse")
            .[A1].CurrentRegion.Clear
            .Cells(1, 1).Resize(UBound(S)) = Application.Transpose(S)
            .[A1].CurrentRegion.TextToColumns Semicolon:=True, DecimalSeparator:=";"
            .[A1].CurrentRegion.Columns(2).FormulaLocal = .Columns(2).Value
            .[A1].CurrentRegion.Columns.AutoFit
          End With
 
        Else
          MsgBox "Erreur de chargement": Exit Sub
        End If
    End With
 
Set oXmlHttp = Nothing
MsgBox Timer - Ti
End Sub

A+

**Marc-L** · 22/06/2016, 16h08

David, ta requête fonctionne bien, juste correction du séparateur décimal en "," au lieu de ";" …
C'est la première fois que je vois un send aussi monstrueux !! Lors de ma première tentative je l'avais par trop élagué …

Patrick, concernant IE, j'ai une idée mais peut-être l'as-tu déjà testée :
utiliser le contrôle WebBrowser d'un UserForm au lieu de piloter IE "en externe" ?

**davido84** · 22/06/2016, 17h53

utiliser le contrôle WebBrowser d'un UserForm au lieu de piloter IE "en externe"

Quel intérêt y vois-tu ?
Celui d'avoir à la possibilité de gérer les événements de l'objet IE ?
Si c'est le but pourquoi pas mais tu peux également passer par un module de classe.
A+

**patricktoulon** · 22/06/2016, 20h00

bonjour tous les deux
@marc j'ai déjà fait cette expérience lors de nos grand débats sur ce sujet
ca a un avantage de piloter la page a la façon IE 09

et oui l argument est long pour la requête mais impossible de vraiment le réduire

**Marc-L** · 23/06/2016, 10h22

Envoyé par davido84

Quel intérêt y vois-tu ?

Patrick a presque anticipé ma réponse :

Envoyé par patricktoulon

ca a un avantage de piloter la page a la façon IE 09

Et comme côté pilotage d'IE ma version préférée est justement la 9 !

Comme on a encore souligné dans cette discussion les difficultés selon les couples IE / Windows,
l'idée serait de s'en affranchir via ce contrôle WebBrowser …
Même si je me doute qu'il dépend de la version d'IE sans compter fonctionne-t-il sur une versions 64 bits d'Excel ?

Patrick, as-tu testé ce contrôle sur diverses configurations, 32 / 64 bits ?

**patricktoulon** · 23/06/2016, 11h55

Bonjour Marc et Davido

et oui j'avais compris ton points de vue (s'affranchir du soucis de la versions (IE/Windows)et oui j'ai testé sur Windows 7 64 ultimate et premium et aussi sur mon tout petit acer 12 pouce (notebook) avec w7 stater 32 bits
et après test
le résultat et le même sur les 3 on est bien dans un fonctionnement des IE inferieurs

la fenêtre de téléchargement n'est plus le bandeau en bas mais bien la fenêtre de téléchargement de IE 8 et 9

ce qui tenterait a prouver ce que je dis depuis longtemps office VBA va chercher la librairie IE ailleurs que dans la dll de IE il semblerait qu' il ai sa propre librairie

teste cela tu va voir les fenêtres

prend un userform assez grand met un webbrowser assez grand aussi et met ce code

on se croirait revenu sur XP et IE 8

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
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
Private Sub UserForm_Activate()
    Dim odoc As Object
    With WebBrowser1
        .Silent = True
        .Navigate "http://www.abcbourse.com/download/historiques.aspx"
        Do: DoEvents: Loop While .readystate <> 4    'Or .busy
         ' Page chargée, on continue
         ' modification de la Valeur date
    .Document.getelementsbyname("ctl00$BodyABC$strDateDeb")(0).Value = "26/05/2015"   
    .Document.getelementsbyname("ctl00$BodyABC$strDateFin")(0).Value = "26/05/2016"
 
    'Application.Wait (Now + TimeValue("0:00:01"))
 
    'modification du n° de la valeur
    .Document.getelementsbyname("ctl00$BodyABC$txtOneSico")(0).Value = "FR0000120222"
    'activer la coche
    .Document.getelementsbyname("ctl00$BodyABC$oneSico")(0).Click
    'combobox du choix de format de sortie
    .Document.getelementsbyname("ctl00$BodyABC$dlFormat")(0).selectedIndex = 4
    ' Clic sur bouton telecharger
    .Document.getelementsbyname("ctl00$BodyABC$Button1")(0).Click
    Do: DoEvents: Loop While .readystate <> 4
 
     End With
     Application.Wait (Now + TimeValue("0:00:02"))
 
' j ai des soucis a partir d'ici  mais on vois bien la fenêtre de téléchargement de IE 8
With CreateObject("WScript.Shell")
        '.SendKeys "{TAB}~"
        .SendKeys "{TAB}"
        Application.Wait (Now + TimeValue("0:00:02"))
     .SendKeys "{TAB}~"
        .SendKeys "{ENTER}"
    End With
 
End Sub

Capture:

après je te l'avais déjà montrer il me semble comment ouvrir IE en mode IE 9 en rajoutant la balise META et en rafraichissant la page :souviens toi bien

**Marc-L** · 23/06/2016, 12h08

Et avec un Excel 64 bits ? (à cause du contrôle ActiveX …)

**patricktoulon** · 23/06/2016, 12h09

et non j'ai pas office 64 j'avais le 2010 d'origine sur mon Portable mais je l'ai vite supprimé

il faut demander a quelqu'un qui a un 64 et tester le code dans un userform

**Marc-L** · 23/06/2016, 12h22

David doit avoir sous le coude une version 64 bits vu ses codes …

Sinon Patrick avec ton code c'est un peu mieux dans le sens où parfois cela peut passer du premier coup
mais si je le relance une seconde fois j'ai de nouveau le souci de la boucle sans fin
à cause du ReadyState bloqué à 3 sur ma config de test Seven & IE9.
Ce souci est particulier à cette page …

Je testerais à ma sauce sur deux configurations bien différentes …

**patricktoulon** · 23/06/2016, 14h08

en tout cas c'est yper rapide (autant qu'une requete) sans doute parce que le webbrowser est a silent=true donc on saute des scripts inutiles
par contre la touche enter n' est pas simulée ni avec le wscript.shell ni avec l'api je comprends pas pourquoi je suis obligé de taper la touche enter a la main
c'est bizarre non ????

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
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Private Sub UserForm_Activate()
    Dim IE As Object, odoc As Object
    With WebBrowser1
        .Silent = True
        .Navigate "http://www.abcbourse.com/download/historiques.aspx"
        Do: DoEvents: Loop While .readystate <> 4    'Or .busy
        ' Page chargée, on continue
        ' modification de la Valeur date
        .Document.getelementsbyname("ctl00$BodyABC$strDateDeb")(0).Value = "26/05/2015"    'la variable entre () => afficher la page et faire afficher la source rechercher la variable
        .Document.getelementsbyname("ctl00$BodyABC$strDateFin")(0).Value = "26/05/2016"
        'modification du n° de la valeur
        .Document.getelementsbyname("ctl00$BodyABC$txtOneSico")(0).Value = "FR0000120222"
        'activer la coche
        .Document.getelementsbyname("ctl00$BodyABC$oneSico")(0).Click
        'combobox du choix de format de sortie
        .Document.getelementsbyname("ctl00$BodyABC$dlFormat")(0).selectedIndex = 4
        ' Clic sur bouton telecharger
        .Document.getelementsbyname("ctl00$BodyABC$Button1")(0).Click
        Do: DoEvents: Loop While .readystate <> 4
        'Sleep 2000
    End With
    Application.Wait (Now + TimeValue("0:00:01"))
    With CreateObject("WScript.Shell")
        '.SendKeys "{TAB}~"
        .SendKeys "{TAB}"
        .SendKeys "{TAB}"
    End With
    Application.Wait (Now + TimeValue("0:00:01"))
 
    '********************************* a touver pourquoi ca ne marche pas !!!!!!******************************
    'la derniere touche ENTER n'est pas tapée je ne sais pas pourquoi
    With CreateObject("WScript.Shell")
        .SendKeys "{ENTER}"
    End With
    ' 2 eme tentative avec l'api
    keybd_event vbKeyReturn, 0&, 0, 0&
    'ne marche pas non plus
 
End Sub

c'est dommage c'est bien rapide

**davido84** · 24/06/2016, 18h03

J'y arrive en gérant la fenêtre de téléchargement via du vbscript mais je ne sais pas si c'est très stable car la combinaison des sendkeys me paraît bizarre.
A+

**patricktoulon** · 24/06/2016, 18h08

Re
Bonjour davido montre ton code vbs
Pour ma. Part je sendkeys dans un vbs
En effet quand la fenetre de telechargement
Arrive avec mon model userform je n ai plus. Le. Focus de la meme maniere qu avec un msgbox on a plus la possibilité. De modifier un sheet

**davido84** · 24/06/2016, 18h14

Ok je livre mais c'est vraiment à titre expérimental...

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
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
Private Sub UserForm_Activate()
Dim IE As Object, odoc As Object
Dim SC$, F%, Fichier$
 
 On Error GoTo fin
 Fichier = ThisWorkbook.Path & "\VbScript.vbs"
 
 SC = "Set wshShell = CreateObject(""WScript.Shell"")" & vbCrLf
 SC = SC & "Do" & vbCrLf
 SC = SC & "ret = wshShell.AppActivate(""Téléchargement de fichiers"")" & vbCrLf
 SC = SC & "Loop until ret = True" & vbCrLf
 SC = SC & "WScript.Sleep 100" & vbCrLf
 SC = SC & "if ret = True Then" & vbCrLf
 SC = SC & "wshShell.SendKeys ""{tab}""" & vbCrLf
 SC = SC & "WScript.Sleep 100" & vbCrLf
 SC = SC & "wshShell.SendKeys ""{tab}""" & vbCrLf
 SC = SC & "WScript.Sleep 100" & vbCrLf
 SC = SC & "wshShell.SendKeys ""{tab}""" & vbCrLf
 SC = SC & "WScript.Sleep 100" & vbCrLf
 SC = SC & "wshShell.SendKeys ""{tab}""" & vbCrLf
 SC = SC & "WScript.Sleep 100" & vbCrLf
 SC = SC & "wshShell.SendKeys ""{enter}""" & vbCrLf
 SC = SC & "End If"
 
F% = FreeFile
Open Fichier For Output As #F
Print #F, SC
Close #F
SC = """" & Fichier & """"
CreateObject("WScript.Shell").Run SC
    With WebBrowser1
        .Silent = True
        .Navigate "http://www.abcbourse.com/download/historiques.aspx"
        Do: DoEvents: Loop While .ReadyState <> 4    'Or .busy
        ' Page chargée, on continue
        ' modification de la Valeur date
        .Document.getelementsbyname("ctl00$BodyABC$strDateDeb")(0).Value = "26/05/2015"
        .Document.getelementsbyname("ctl00$BodyABC$strDateFin")(0).Value = "26/05/2016"
        'modification du n° de la valeur
        .Document.getelementsbyname("ctl00$BodyABC$txtOneSico")(0).Value = "FR0000120222"
        'activer la coche
        .Document.getelementsbyname("ctl00$BodyABC$oneSico")(0).Click
        'combobox du choix de format de sortie
        .Document.getelementsbyname("ctl00$BodyABC$dlFormat")(0).selectedIndex = 4
        ' Clic sur bouton telecharger
        .Document.getelementsbyname("ctl00$BodyABC$Button1")(0).Click
        Do: DoEvents: Loop While .ReadyState <> 4
    End With
 
fin:
Kill Fichier
End Sub

A+

**patricktoulon** · 24/06/2016, 18h20

Oui c est sensiblement pareilque. Les. Version que l on utilise Marc et moi sauf que tu lance le vbs avant tournant en boucle en attendant la fenêtre je le lancerait apres moi pour economiser l UC

**davido84** · 24/06/2016, 18h33

Oui éventuellement mais déjà est-ce que cela fonctionne chez toi ? Personnellement je trouve bizarre la combinaison des sendkeys pour valider le téléchargement...

**patricktoulon** · 24/06/2016, 18h36

No' la combinaison n est pas bonne trop de TAB CA REVIENS A ANNULER

Piloter la fenetre windows en vba

Macros et VBA Excel

Discussions similaires

Partager

Partager