Enregistrement d'un fichier csv téléchargé via Internet Explorer (VBA)

Version imprimable

1 pièce(s) jointe(s)

Bonjour à tous,

Alors j'essaie d'automatiser le téléchargement de données. Je bute sur le moment où je dois gérer la boite de téléchargement de IE (ENREGISTRER/ENREGISTRER SOUS/ANNULER).

J'ai donc testé 2 sub dans mon classeur (en PJ). La 1ère permet de naviguer sur IE et d'aller directement vers le fichier voulu sauf qu'on tombe sur cette fameuse boite de téléchargement.. Et je n'arrive pas à la gérer avec mon code.

La 2e sub est une idée trouvée sur un forum qui avec les fonctions "URLDownloadToFile" et "DownloadFile" (au dessus des sub) permettrait (dans l'idéal) d'effectuer le téléchargement que je souhaite..

SUB1:
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 Sub enregistrement_fichier_csv_1() 'declarations pour les outils de navigation Dim ie As InternetExplorer Const CheminRep As String = "C:\Users\\Documents\Fichiers YAHOO" 'lien internet vers lequel aller: Yahoo Finance Set ie = New InternetExplorerMedium ie.Visible = True ie.Navigate ("http://real-chart.finance.yahoo.com/table.csv?s=%5EFCHI&d=8&e=21&f=2016&g=d&a=2&b=1&c=1990&ignore=.csv") End Sub
SUB2:
Code:

1 2 3 4 5 6 7 8 9 Sub enregistrement_fichier_csv_2() Const CheminRep As String = "C:\Users\\Documents\Fichiers YAHOO" DownloadFile _ "http://real-chart.finance.yahoo.com/table.csv?s=%5EFCHI&d=8&e=21&f=2016&g=d&a=2&b=1&c=1990&ignore=.csv" _ , CheminRep End Sub
Merci d'avance pour l'aide que vous pourrez me fournir!

21/09/2016, 14h57
Jean-Philippe André

Bonjour,

le sujet des telechargements de donnees yahoo finance en VBA a deja fait l'objet de solutions :

http://www.developpez.net/forums/d10...yahoo-finance/

1 pièce(s) jointe(s)

Merci Jean-Philippe, en fait YAHOO Finance n'est qu'un exemple. Si on considère plutôt le cas du site abc bourse (https://www.abcbourse.com/download/download.aspx?s=PX1p), en essayant d'avoir les cours du CAC.

Dans le code HTML il n'y a pas de HREF, c'est un type "submit". Vous voyez dans le problème que je rencontre le HREF n'est pas directement la référence au fichier à télécharger ce qui m'empêche d'utiliser la solution classique (Workbooks.Open Filename:= ). Je mets en PJ le code pour cet exemple, je ne vois pas comment contourner le problème qui reste la boite de dialogue IE.

Mon code: Pièce jointe 220834
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 Sub enregistrement_fichier_csv_1() 'declarations pour les outils de navigation Dim ie As InternetExplorer Dim Lien As HTMLGenericElement Const CheminRep As String = "C:\Users\Documents\Fichiers YAHOO" 'lien internet vers lequel aller: Set ie = New InternetExplorerMedium ie.Visible = True ie.Navigate ("https://www.abcbourse.com/download/download.aspx?s=PX1p") 'attente de fin de chargement tmp = Time Do While (Time < tmp + TimeValue("0:0:7")) Loop 'dans toutes les balises "CLASS" on cherche celle contenant le HREF ci-dessous puis on CLIQUE Set coll_liens = ie.document.getElementsByTagName("input") For Each Lien In coll_liens If Lien.Name = "ctl00$BodyABC$Button1" Then 'Workbooks.Open Filename:=Lien.href LA SOLUTION PROPOSEE QUI NE MARCHE PAS Lien.Click: Exit For 'OUVRE LA PAGE DE DIALOGUE ENREGISTRER/ENREGISTRER SOUS/ ANNULER End If Next End Sub
ATTENTION: si vous tenter de faire tourner la macro, mettez abc bourse en tant que site de confiance, sinon ça bug..je ne sais pas trop pourquoi.

21/09/2016, 16h19
Jean-Philippe André

Ok, du coup je te renvoie vers un sujet riche :
http://www.developpez.net/forums/d14...elechargement/
21/09/2016, 16h32
VBA learner

Je viens de jeter un coup d'œil, merci beaucoup Jean-Philippe!

Bonsoir

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
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
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare Function BringWindowToTop Lib "user32" (ByVal hwnd As Long) As Long
Dim IE As Object, TTVE As Long, mode%, T!, hwndIEedge As Long
Sub Demo4UI()
    If ref_UI = False Then adddref "Demo4UI": Exit Sub
    Const ELT = "ctl00_BodyABC_Button1"
    Dim Wb As Workbook, mess As String
    T = Timer
    For Each Wb In Workbooks
        If Wb.Name Like "Cotations*.csv" Then Wb.Close False
    Next
    Set IE = CreateObject("InternetExplorer.Application")
    With IE
        .Navigate "https://www.abcbourse.com/download/download.aspx?s=PX1p"
        .Visible = True    'facultatif!!!!!!!
        While .ReadyState < 4
            mess = "IE n'etait pas ready !!!"
            If Timer - T > 9 Then GoTo Fin
        Wend
        While Not IsObject(.Document.all(ELT))
            mess = "l'object " & ELT & " n'a pas été trouvé "
            If Timer - T > 9 Then GoTo Fin
        Wend
        On Error GoTo Fin
        With .Document.all
            .Item(ELT).Click
        End With
        .Visible = True
        mess = "relax ca va trop vite!!"
        Sleep 1000
        TTVE = 0
        Bandeau "Ouvrir" ' ou  "Enregistrer"
    End With
    Exit Sub
Fin:
    MsgBox mess, vbCritical
    IE.Quit
End Sub
Sub adddref(fonction)
    Dim vbProj As Object
    On Error Resume Next
    Set vbProj = ThisWorkbook.VBProject
    vbProj.References.AddFromFile "C:\Windows\System32\UIAutomationCore.dll"
    On Error GoTo 0
    fonction
End Sub
Function ref_UI()
    Dim Ref
    ref_UI = False
    For Each Ref In ThisWorkbook.VBProject.References
        If Ref.Name = "UIAutomationClient" Then ref_UI = True
    Next Ref
End Function
Sub Bandeau(mode)
    Dim oIUIAIP As IUIAutomationInvokePattern, oCUIA As New CUIAutomation
    On Error Resume Next
    HIEFRAME = IE.hwnd    'FindWindow("IEFrame", vbNullString)
    BringWindowToTop HIEFRAME
    hwndIEedge = 0
    Do    'recherche du handle bandeau
        DoEvents: i = i + 1
        hwndIEedge = FindWindowEx(HIEFRAME, 0&, "Frame Notification Bar", vbNullString)     'recherche du handle de la fenetre de telechargement IE edge
    Loop While hwndIEedge = 0 Or i = 20000
    BringWindowToTop HIEFRAME
    Sleep 1000
    On Error GoTo rep
    Set oIUIAIP = oCUIA.ElementFromHandle(ByVal hwndIEedge).FindFirst(TreeScope_Subtree, oCUIA.CreatePropertyCondition(UIA_NamePropertyId, mode)).GetCurrentPattern(UIA_InvokePatternId)
    oIUIAIP.Invoke
    Set oIUIAIP = Nothing: Set oCUIA = Nothing
    Sleep 500:
    IE.Quit
    Exit Sub
rep:
    Err.Clear
    TTVE = TTVE + 1
    If TTVE < 3 Then Application.OnTime Now + TimeValue("00:00:01"), "Bandeau"
End Sub

22/09/2016, 00h15
Marc-L

Bonjour !

Citation:

Envoyé par Jean-Philippe André

Ok, du coup je te renvoie vers un sujet riche :
http://www.developpez.net/forums/d14...elechargement/

C'est la contribution que je lui ai déjà conseillée (et pour cause !) dans sa précédente discussion du forum Excel !
Il y a même un nouveau classeur de démonstration pour abcbourse dans le post #162
avec une explication supplémentaire dans l'édit du bas du post #166 …
En remontant dans la discussion, Patrick nous a même sorti un code pilotant la souris !

Sans compter une discussion récente de cet été dans ce forum spécifiquement pour abcbourse
dans laquelle la voie la plus efficace - la requête - y a été aussi explorée,
le pilotage d'un navigateur devant rester la solution de dernier recours.

_________________________________________________________________________________________________________
L'avenir n'appartient pas qu'à ceux se levant tôt mais surtout à ceux se donnant la peine de lire …

Merci à vous deux, grâce à votre aide, vos liens, j'ai pu trouver la solution à mon problème.

Si cela intéresse une personne avec mon problème spécifiquement, voilà la solution:
1) faire un focus sur le bouton qui vous ouvre la boite de téléchargement, puis cliquer
2) compter le nombre de tab jusqu'à la boite
3) avec la ligne de code contenant le sendkeys, LE TOUR EST JOUE!!!!!!

La fin de mon code:
Code:

1 2 3 4 5 6 7 8 9 10 For Each Lien In coll_liens If Lien.ID = "nomDuLienCherche" Then Lien.Focus Lien.Click Application.Wait Now + 0.00011: ie.Visible = True 'augmenter peut etre le temps CreateObject("WScript.Shell").SendKeys "{Tab 7}~" Application.Wait Now + 0.00001: Exit For End If Next

22/09/2016, 10h43
patricktoulon

re

re
bonjour
gare au surprise avec les sleep trop court et les senkeys trop attifs si tu a visité les liens que l'on t a donné tu a du t'apercevoir du problème
selon les pc ou version d'exel Windows/IE ca derappe
22/09/2016, 11h56
Marc-L

Je confirme ! Ce code est valable peut-être uniquement sur l'ordinateur où il a été conçu car
un changement de version d'IE ou de Windows, et hop, il ne marche plus !
Et aucunement besoin d'une boucle pour cliquer sur un bouton ‼

Sinon mieux vaut utiliser la ~~fonction~~ méthode Sleep (externe) que Wait (interne au VBA).

Tester à minima la pièce jointe du classeur #162 ‼ Voir les procédures IEAuto …

La version avec requête est au moins trois fois plus rapide et fiable à 100 % ! (voir la discussion de pulco41)
22/09/2016, 12h10
patricktoulon

re

Citation:

Application.Wait Now + 0.00011: ie.Visible = True 'augmenter peut etre le temps

:ptdr::ptdr:
11 seconde waoh!! tu speed!!!!!

Edit
bon sans rigoler tu comprends bien que 11 secondes pour une première attente c'est inconcevable pour un CSV(fichier text)

déjà si tu tiens a garder tes sendkeys
plutôt que tes "Wait" met la do loop sur le handle du bandeau se sera déjà plus sérieux
et comme te la dis marc utilise le sleep(api) on peut la réduire infiniment parfois même une seconde c'est trop
22/09/2016, 12h16
Marc-L

0.00011 * 86400 = 9,5 secondes !

Patrick a raison, et comme déjà indiqué, mieux vaut utiliser la méthode Sleep.

De mon côté sur la configuration de tests la plus rapide, il faut à peine 5s lors du premier lancement
puis 2 ensuite avec le cache … Et avec une requête, c'est encore bien plus rapide !
22/09/2016, 12h23
patricktoulon

re
je viens de regarder a nouveau le depart de ton code
la gestion d'attente du ready sur ie ou meme le document existe
toi tu fait
Code:

1 2 3 tmp = Time Do While (Time < tmp + TimeValue("0:0:7")) Loop
7 seconde non la c'est tout bonnement un (je n'ai pas de nom)

la gestion d'attente c'est
exemple le plus simple

Code:

do:doevents:loop until IE.readystate=4

je vais t'en faire un avec des gestion d'attente digne de ce nom et reviens
22/09/2016, 12h25
Marc-L

T'embêtes pas Patrick, il devrait déjà commencer par le B-A-BA, à savoir le tutoriel de Stéphane !

Sans ce minima, à quoi bon ?! De toute manière, il y a déjà tout ce qu'il faut dans nos codes mais qu'en a t-il-fait ? Rien !

fait moi plaisir l'apprenti VBAtiste
teste cela dans un fichier vierge

bandeau Ie,1 pour ouvrir
Bandeau Ie,2 pour enregistrer dans le dossier des téléchargements

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
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare Function BringWindowToTop Lib "user32" (ByVal hwnd As Long) As Long
Sub enregistrement_fichier_csv_1()
 
'declarations pour les outils de navigation
Dim Ie As Object
 Dim bouton  As Object
Set Ie = CreateObject("internetexplorer.application")
Ie.Visible = True
Ie.Navigate ("https://www.abcbourse.com/download/download.aspx?s=PX1p")
'attente de fin de chargement de la page
Do: DoEvents: Loop Until Ie.readystate = 4
Set bouton = Ie.document.all("ctl00$BodyABC$Button1") 'on capte le bouton
         bouton.Click:
  bandeau Ie, 2
End Sub
Sub bandeau(Ie, mode)
HIEFRAME = Ie.hwnd
    BringWindowToTop HIEFRAME
    hwndIEedge = 0
    Do    'recherche du handle bandeau
        DoEvents: i = i + 1
        hwndIEedge = FindWindowEx(HIEFRAME, 0&, "Frame Notification Bar", vbNullString)     'recherche du handle de la fenetre de telechargement IE edge
    Loop While hwndIEedge = 0 Or i = 20000
    BringWindowToTop HIEFRAME
    Sleep 1000
 With CreateObject("WScript.Shell")
         If mode = 2 Then .SendKeys "{Tab}"
         .SendKeys "{Tab}~"
End With
sleep 500 :Ie.quit
End Sub

tu m'en diras des nouvelle

22/09/2016, 17h05
VBA learner

Je suis très reconnaissant pour votre aide. J'avais un problème, que vous m'avez permis de résoudre. Mon programme n'est certes pas parfait, ni optimal mais cela n'est pas mon but et surtout je n'en ai tout simplement pas le temps.
Tout fonctionne à l'heure actuelle, j'ai même réduit mes temps d'attentes. Je testerai ton code Patrick.
Encore merci pour tout.
Cordialement.