Discussion :

[GregCompta]

Bonjour à tous,

Le soucis qui me tracasse n'est pas très commun, et j'espère ne pas faire doublon avec un autre post, car malgré mes longues, exhaustives et infructueuses recherches, je n'ai trouvé aucune réponse !!! Je vous soumet donc mon problème, code et fichier excel de manière à mieux appréhender ma requête.

Ce qui se passe ! => Le code fonctionne parfaitement bien sur mon PC (qui lui est sous Excel 2016) sauf que lorsque je l'exécute à mon boulot, ça plante et me met le message d'erreur ci-dessous.
Je pense que c'est juste un problème de version, mais je ne suis pas expert... Si c'est cela, qui peut me dire comment adapter mon code svp ?

Le fichier : il recherche une page sur internet (cours de conversion), l'enregistre dans un fichier tampon, par la suite supprimé, et extrait chaque cours en fonction de sa devise.
Si c'est possible, j'aurais bien aimé aussi que quelqu'un me dise comment optimiser le code car il rame un petit peu..

Merci mille fois à vous de votre aide..



Voici le message d'erreur




Code pour la récupération de la page web

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
 
Option Explicit
    Dim dc As Long
    Dim page_web As String
    Dim chemin As String
    Dim donnees_fichier() As Byte
    Dim objet_reponse As Object
 
Sub recuperer_web()
 
dc = ThisWorkbook.Worksheets("Cours").Cells(2, Columns.Count).End(xlToLeft).Column
If ThisWorkbook.Worksheets("Cours").Cells(2, dc).Value = Date Then
    MsgBox "Il existe déjà les devises d'aujourd'hui", vbInformation + vbOKOnly, "MISE A JOUR"
    Exit Sub
End If
 
Set objet_reponse = Nothing
Set objet_reponse = CreateObject("WinHTTP.WinHTTPrequest.5.1")
 
page_web = "http://www.boursorama.com/bourse/devises/parite.phtml"
chemin = ThisWorkbook.Path & "\donnees.txt"
 
With objet_reponse
    .Open "GET", page_web, False
    .Send
    donnees_fichier = .ResponseBody
End With
Set objet_reponse = Nothing
 
Open chemin For Binary Access Write As #9
    Put #9, 1, donnees_fichier
Close #9
 
Call recuperer_taux(chemin)
Kill chemin
 
End Sub

Code pour l'extraction des devises

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
 
Sub recuperer_taux(chemin As String)
Dim contenu As String, contenu_intermediaire As String: Dim taille_fichier As Long
Dim position_fin As Long: Dim position_depart As Long
Dim i As Long, dc As Long, dl As Long, Devise As String
 
contenu = ""
Open chemin For Input As #1
If LOF(1) = 0 Then Exit Sub
    Do While EOF(1) <> True
        Line Input #1, contenu_intermediaire 'taille_fichier = LOF(1)
        contenu = contenu & contenu_intermediaire 'input(taille_fichier, 1)
    Loop
Close #1
 
dc = ThisWorkbook.Worksheets("Cours").Cells(2, Columns.Count).End(xlToLeft).Column + 1
ThisWorkbook.Worksheets("Cours").Cells(2, dc).Value = Now
dl = ThisWorkbook.Worksheets("Cours").Range("A" & Rows.Count).End(xlUp).Row
 
For i = 3 To dl Step 1
 
    position_depart = InStrRev(contenu, Worksheets("PaysDevise").Cells(i - 1, 3) & "</td>")
    If position_depart = 0 Then
        Devise = Mid(contenu, 1, Len(contenu))
    Else
        Devise = Mid(contenu, position_depart, Len(contenu))
    End If
        position_fin = InStr(1, Devise, "</span>")
        Devise = Left(Devise, position_fin)
    position_depart = InStrRev(Devise, ">") + 1
    Devise = Mid(Devise, position_depart, position_fin - position_depart)
 
    Devise = Replace(Devise, " ", "")
 
ThisWorkbook.Worksheets("Cours").Cells(i, dc).Value = Devise
Next i
 
End Sub

Fichier :
Cours de Conversion.xlsm

[patricktoulon]

Bonjour
a quoi te sert il d'enregistrer ton document sur le disque dur ?

pas besoins de tout ce toin toin

1. une requete
2. recupe du code html
3. integration dans un htmldocument en mémoire
4. recuperation du/des elements que tu veux en outerhtml
5. mise en clipboard du code obtenu dans le clipboard du parent de l'htmldocument virtuel
6. paste sur le sheets

exemple met ca dans un module d'un fichier vierge et teste

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
Sub recuperer_web()
    URL = "http://www.boursorama.com/bourse/devises/parite.phtml"
    With CreateObject("WinHTTP.WinHTTPrequest.5.1"): .Open "GET", URL, False: .Send: code = .Responsetext: End With
    With CreateObject("htmlfile")
        .body.innerhtml = code
        '
        ' ici on peu osculter le document comme si c'etait dans IE et recupérer le/la/les données que l'on  veut en utilisant la librairie IE (getelementsby......)
        ' d'ailleurs ci dessous je recupere la table des devise en entier
        Set matable = .getelementsbytagname("TABLE")(0)
        '
        ' facultatif
        'pour eviter d'avoir les yperlink sur le sheets on va netoyer le code simplement comme ceci
        Set mes_TD_a_netoyer = matable.getelementsbytagname("TD")
        For i = 0 To mes_TD_a_netoyer.Length - 1
            mes_TD_a_netoyer(i).innerhtml = mes_TD_a_netoyer(i).innertext
        Next
        'integration dans le clipboard
        If .parentWindow.clipboardData.setData("Text", matable.outerhtml) Then
            Application.ScreenUpdating = False
            With Sheets("Cours"): .Activate: .Cells(Rows.Count, 1).End(xlUp).Select: .Paste: End With
            .parentWindow.clipboardData.clearData "Text"
        End If
    End With
End Sub

rien de bien compliqué

[Ben_L]

Bonjour,

Depuis votre lieu de travail, vous est-il possible d'accéder à la page en question avec un navigateur ?
Si non, il y a potentiellement un problème de pare-feu.

A part ça, avez-vous essayé d'utiliser les méthodes suivantes :

Code :

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

WinHttp.SetTimeouts(ResolveTimeout, ConnectTimeout, SendTimeout, ReceiveTimeout)

Code :

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

WinHttp.WaitForResponse(Timeout, Succeeded)

[patricktoulon]

peut être devrait il choir d'utiliser l'object "Microsoft.xmlhttp" a la place du winrequest

[Ben_L]

Jamais utilisé cet objet jusqu'ici.
Mais il semble qu'il permette de gérer plus proprement l'aspect asynchrone des requêtes web (voir ici).

Reste à savoir si cela est facilement utilisable en vba...
Patrick, auriez-vous par hasard un exemple d'utilisation dans Excel ?

Cordialement

[patricktoulon]

je viens de faire les test
et je n'arrive pas a causer l'erreur même en appliquant un settimeouts ( lResolve, lConnect, lSend, lReceive)

parcontre l'erreur en vba a l'inverse de vb6 l'erreur est bloquante pour le ontimeout ce qui fait que l'on peut pas faire de callback puisque bloqué par le message original

donc seul moyen une gestion d'erreur sur le status

meme encore la ca match pas a tout les coups

Code :

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

1
2
3
4
5
6
7
8
9
XMLHTTP.Send
 
If XMLHTTP.Status = "200" Then
    '200      OK
    htmlString = XMLHTTP.ResponseText
Elseif XMLHTTP.Status = "408" Then
    '408      Request Timeout
    Call OnTimeOutMessage
end if

tout les status
'Number Description
'100 Continue
'101 Switching protocols
'200 OK
'201 Created
'202 Accepted
'203 Non-Authoritative Information
'204 No Content
'205 Reset Content
'206 Partial Content
'300 Multiple Choices
'301 Moved Permanently
'302 Found
'303 See Other
'304 Not Modified
'305 Use Proxy
'307 Temporary Redirect
'400 Bad Request
'401 Unauthorized
'402 Payment Required
'403 Forbidden
'404 Not Found
'405 Method Not Allowed
'406 Not Acceptable
'407 Proxy Authentication Required
'408 Request Timeout
'409 Conflict
'410 Gone
'411 Length Required
'412 Precondition Failed
'413 Request Entity Too Large
'414 Request-URI Too Long
'415 Unsupported Media Type
'416 Requested Range Not Suitable
'417 Expectation Failed
'500 Internal Server Error
'501 Not Implemented
'502 Bad Gateway
'503 Service Unavailable
'504 Gateway Timeout
'505 HTTP Version Not Supported

donc en vba gérer par on error sur le numéro de status

par contre le settimeouts reste valable pour vba

ca te permet quand même d'imposé un delay max

[Ben_L]

Bonjour Patrick,

Merci à vous pour ces tests et infos.
Je ferai un essai dans les jours à venir, histoire de mieux maîtriser les différences par rapport à WinHTTPrequest.

Cordialement

[GregCompta]

patricktoulon :

Merci pour ton 1er post : il fonctionne nickel sur mon pc, mais encore une fois pas du tout sur celui du travail. Ca bug toujours au même endroit : le .send.
De plus, j'aime beaucoup la présentation et j'avoue que le code est totalement nouveau pour moi (je n'aurais jamais trouvé tout ça seul !! ), mais je n'ai besoin que des cours au quotidien (chaque jour à 9h je lancerais la macro pour faire un suivi temporis).




Ben_L :

Effectivement je pense aussi qu'il y a un soucis côté pare-feu ou quelque chose comme ça. Mais j'accède très bien à la page en mode manuel par contre ! (je copie colle l'url dans mon navigateur et tombe bien dessus.. (heureusement pour le poste que j'occupe je dirais.. lol))

A part ça, avez-vous essayé d'utiliser les méthodes suivantes :
Visualiser dans une fenêtre à part

Code :

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

 WinHttp.SetTimeouts(ResolveTimeout, ConnectTimeout, SendTimeout, ReceiveTimeout)

Visualiser dans une fenêtre à part

Code :

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

 WinHttp.WaitForResponse(Timeout, Succeeded)

Oui, j'ai essayé la 1ère méthode je dirais (voir mon 1er post) mais celle du .waitforresponse je ne crois pas (à me confirmer..)
Comment dois-je l'utiliser pour que ça colle ?


patricktoulon :
C'est avec plaisir que j'utiliserai cet objet. Je l'ai déjà vu dans d'autres posts mais n'ai pas bien compris à ce moment. D'ailleurs j'avais tenté de l'utiliser mais en vain.
Je vais voir votre lien, et voir avec ce que vous avez inscrit dans votre 2nd post. Mais je ne pourrais pas revenir vers vous de suite.
En tout cas j'ai pu trouvé la référence. Ya plus qu'à dirais-je


Merci à tous en tout cas !! Vraiment !
Je reviens vers vous dès que la nouvelle macro est testée.



patricktoulon, PS :
Je vais resté sur mon ancienne macro car je ne vois pas comment récupérer mes données tout en les classant par colonne (et par devise bien évidemment), jours après jours
Tentatives exécutées hier soir pendant 2 à 3 heures.. :'(

Voici ce que je désire in fine :



A très vite !

[Ben_L]

Je ne vois pas trace, dans votre 1er post, de l'utilisation de SetTimeOut.
Ni de WaitForResponse d'ailleurs, mais cela est a priori sans impact (si Excel plante sur la ligne .Send, ce qui pourrait être ajouté après à peu de chance de corriger le problème).

Tester l'objet XMLhttp, comme le propose Patrick, semble la première chose à faire.
Si toutefois cela ne vous permettait pas d'obtenir le résultat attendu, il y a 2 autres pistes à explorer avec WinHttpRequest :

1. La méthode .SetProxy pourrait vous être utile.
2. L'utilisation de .SetRequestHeader a également une chance de fonctionner. Cette méthode permet de spécifier les entêtes d'une requête, pour mimer au mieux le comportement d'un navigateur.

Cordialement

[patricktoulon]

en attendant si tu a vraiment des soucis avec la requete fait le avec IE la page est pas trop chargée c'est pas long

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
'http://www.boursorama.com/bourse/devises/parite.phtml
Sub test()
    Dim URl
    URl = "http://www.boursorama.com/bourse/devises/parite.phtml"
    With CreateObject("internetexplorer.application")
        .navigate URl:    '.Visible = True
        Do: DoEvents: Loop While .readystate <> 4 Or .busy
        code = .document.getelementsbytagname("TABLE")(0).outerhtml
        .Quit
    End With
    With CreateObject("htmlfile")
        .body.innerhtml = code
        Set matable = .getelementsbytagname("TABLE")(0)
        '
        ' facultatif
        'pour eviter d'avoir les yperlink sur le sheets on va netoyer le code simplement comme ceci
        Set mes_TD_a_netoyer = matable.getelementsbytagname("TD")
        For i = 0 To mes_TD_a_netoyer.Length - 1
            mes_TD_a_netoyer(i).innerhtml = mes_TD_a_netoyer(i).innertext
        Next
        '
        ''integration dans le clipboard
        If .parentWindow.clipboardData.setData("Text", .body.innerhtml) Then
            Application.ScreenUpdating = False
            With Sheets("Cours"): .Activate: .Cells(Rows.Count, 1).End(xlUp).Select: .Paste: End With
            .parentWindow.clipboardData.clearData "Text"
        End If
    End With
 
End Sub

[Marc-L]

peut être devrait il choir d'utiliser l'object "Microsoft.xmlhttp" a la place du winrequest

Salut Patrick !

Préférer WinHttpRequest quand les cours peuvent changer de minute en minute (pas de cache).
Tout dépend donc du contexte mais vu la présentation initiale par trop légère …

___________________________________________________________________________________________________________
Je suis Paris, Barcelone, London, Manchester, Egypte, Stockholm, Istanbul, Berlin, Nice, Bruxelles, Charlie, …

[patricktoulon]

oui surtout que l'object"microsoft.xmlhttp" ne gère pas l'imposition du settimeout il est absent de cette librairie ( c'est le fond de cette discussion)

mais plus rapide chez moi pour le lien de cette exemple en méthode post

[GregCompta]

Holà todos !!

Alors (...) après m'être rapproché de l'informatique, il y a évidemment bien l'utilisation d'un proxy (j'avais le droit de rêver.. )

Je suis bloqué pour le moment car vacances obligent :'(

Je reprends mes investigations excel à leur retour.. et vous tiens au courant. De ce que j'ai compris, seul WinHTTP gère la partie proxy. Je vais aussi tenter avec IE, mais quand j'aurais 2 minutes.. On entre en période de clôture !

Merci à vous en tout cas pour votre expertise et vous dis à très bientôt.

NB : Comme le sujet reste en cours de traitement, je ne le mets pas encore en Résolu.

Bien à vous,