Discussion :

[alexvbad]

Hello,

Voici mon souci : je dois extraire des données puis les copier sur un classeur. L'extract est un .csv et voici le code :

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
 Sub test()
Dim IE As Object, Choix As Object
Dim S As String
Dim i As Integer
Dim nbnoms As Integer
Dim InputISDABouton As HTMLInputElement
 
 
 
 
Set IE = CreateObject("InternetExplorer.Application")
IE.Visible = True
 
 
 
nbnoms = Cells(3, 5).Rows.Count
 
For i = 4 To 5
 
DoEvents
IE.navigate "http://www.swapsinfo.org/charts/swaps/market-risk-activity?date_start=2015-01-01&date_end=2017-02-15&products=snre%2Cindex&suggest=&search=" & Workbooks("cds liquidity.xlsm").Sheets(7).Cells(i + 2, 6) & "&type=&submit=Update+Data"
Do Until IE.readyState = 4
DoEvents
Loop
 
Set IEdoc = IE.document
 
Set InputISDABouton = IEdoc.all("export-data")
InputISDABouton.Click
 
IEdoc.Focus
 
Application.Wait Now + TimeValue("0:0:2")
Application.SendKeys "%{O}"
 
 
 
For Each Wb In Workbooks
 If Right(Wb.Name, 4) = ".csv" Then
 Wb.Activate
 End If
 Next
 
 
Sheets(1).Select
 
Columns("A:A").Select
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
:=Array(Array(1, 1), Array(2, 1), Array(3, 1)), TrailingMinusNumbers:=True
 
Columns("A:C").Select
Selection.Copy
 
Application.DisplayAlerts = False
ActiveWorkbook.Close Save = False
 
Workbooks("cds liquidity.xlsm").Activate
Sheets("calculs").Select
Columns("A:C").Clear
Range("A1").Select
 
ActiveSheet.Paste
 
 
Range("K2:Y2").Select
Selection.Copy
 
Sheets("main").Select
Cells(2 + i, 3).Select
ActiveSheet.Paste
 
 
 
Next i
 
Set IE = Nothing
Set IEdoc = Nothing
 
 
 
 
End Sub

Je n'arrive pas a comprendre pourquoi juste après la demande d'export (et donc l'ouverture supposée du CSV) le csv s'ouvre apres le debug. Mais si je mets un point d'arrêt juste apres la commande Application.SendKeys "%{O}" et que je relance le reste de la macro ensuite tout se passe bien...

J'ai essayé les sleep, wait now + .. et tout ce qui peut me faire gagner du temps, ça n'a aucun effet. je suis vraiment perdu sur ce coup... j'imagine que c'est la commande sendkey qui provoque ça mais je n'arrive pas à résoudre ce souci.

Si quelqu'un voit une solution il est le bienvenu

[mercatog]

Le csv est le dernier classeur dans la collection workbooks

Il faudra laisser une tempo de téléchargement du csv

Code :

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

1
2
3
4
5
Application.Wait Now + TimeValue("0:0:2")
Application.SendKeys "%{O}"
Application.Wait Now + TimeValue("0:0:5")
 
Set Wbk = Workbooks(Workbooks.Count)

[alexvbad]

Salut mercatog, merci pour la réponse mais même avec 10sec ca ne change rien (et ca m'enlève aussi le verr num je ne sais pas pourquoi).

[mercatog]

Pour verr num c'est connu à cause des sendkeys

Sinon une alternative en gymnastique ( je ne sais pas si c'est une question de cookies)
J'ouvre la page correspondant à l'action X dans Internet Explorer, ensuite je fais une requête par xmlhttp

J'attendrai entre autre Qwazerty, Marc-L ouPatricktoulon pour une piste du pourquoi


Fais des tests chez toi

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
Option Explicit
 
Sub MesTelechargements()
Dim DD As String, DF As String, Url As String
Dim i As Integer, N As Integer
Dim IE As Object
 
N = 6
DD = Format(DateSerial(2015, 1, 1), "yyyy-mm-dd")
DF = Format(Now, "yyyy-mm-dd")
 
Set IE = CreateObject("InternetExplorer.Application")
IE.Visible = True
 
For i = 1 To N
    DoEvents
    Url = "http://www.swapsinfo.org/charts/swaps/market-risk-activity?date_start=" & DD
    Url = Url & "&date_end=" & DF & "&products=snre%2Cindex&suggest=&search="& i
    Url = Url & "&type=&submit=Update+Data"
 
    IE.navigate Url
    Do Until IE.readyState = 4
        DoEvents
    Loop
    Telecharge i
Next i
 
IE.Quit
Set IE = Nothing
End Sub
 
Private Sub Telecharge(ByVal Action As Integer)
Dim S As String, UrlTmp As String, MonFichier As String
Dim Req As Object
 
UrlTmp = "http://www.swapsinfo.org/download/index/cdaf3d57f0bc68356ecf58c4235a8311c10f5d91/CDS%20Market%20Risk%20Activity"
Set Req = CreateObject("microsoft.xmlhttp")
With Req
    .Open "GET", UrlTmp, False
    .Send
    S = .Responsetext
End With
Set Req = Nothing
 
MonFichier = ThisWorkbook.Path & "\Data_" & Action & ".csv"
Open MonFichier For Output As #1
Print #1, S
Close #1
End Sub

[alexvbad]

Le csv est le dernier classeur dans la collection workbooks

Il faudra laisser une tempo de téléchargement du csv

Code :

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

1
2
3
4
5
Application.Wait Now + TimeValue("0:0:2")
Application.SendKeys "%{O}"
Application.Wait Now + TimeValue("0:0:5")
 
Set Wbk = Workbooks(Workbooks.Count)

Ok je vais essayer de tester ça


En revanche je réalise que j'ai mal formulé mon problème : En fait le classeur csv ne s'ouvre que si il y a debuggage (car avant il sélectionne mon classeur natif et me demande s'il peut écraser certaines valeurs, j'appuie alors sur annuler puis débogage et à ce moment la le csv se lance. Si je n'appuie pas sur annuler le code continue mais trop tard le code travaille sur l'autre classeur) ou, si je mets un point d'arrêt ligne 38, je lance (le csv se lance) et puis je lance apres la suite ligne 38 et la bizarrement le travail est fait sur le csv.

[mercatog]

Pour directement insérer les données dans le fichier en cours en ajoutant une feuille par action

J'ai ajouté un test car même si une requête aucune donnée n'est disponible pour une action donnée, le fichier de la dernière action est téléchargé

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
Option Explicit
 
Sub ImportAllData()
Dim DD As String, DF As String, S As String, ReqUrl As String, IeUrl As String
Dim IE As Object, Req As Object
Dim i As Integer, N As Integer
Dim Tb
 
Application.ScreenUpdating = False
N = 6
DD = Format(DateSerial(2015, 1, 1), "yyyy-mm-dd")
DF = Format(Now, "yyyy-mm-dd")
 
ReqUrl = "http://www.swapsinfo.org/download/index/cdaf3d57f0bc68356ecf58c4235a8311c10f5d91/CDS%20Market%20Risk%20Activity"
 
Set Req = CreateObject("microsoft.xmlhttp")
Set IE = CreateObject("InternetExplorer.Application")
IE.Visible = True
 
For i = 1 To N
    DoEvents
    IeUrl = "http://www.swapsinfo.org/charts/swaps/market-risk-activity?date_start=" & DD
    IeUrl = IeUrl & "&date_end=" & DF & "&products=snre%2Cindex&suggest=&search=" & i
    IeUrl = IeUrl & "&type=&submit=Update+Data"
 
    IE.navigate IeUrl
    Do Until IE.readyState = 4:
        DoEvents
    Loop
 
    If InStr(IE.document.body.innertext, "No data was returned. Please modify your filter parameters.") = 0 Then
        With Req
            .Open "GET", ReqUrl, False
            .Send
            S = .Responsetext
        End With
 
        Tb = Split(S, vbLf)
 
        With ThisWorkbook
            With .Sheets.Add(After:=.Sheets(.Sheets.Count)).Cells(1, 1).Resize(UBound(Tb) + 1)
                .Value = Application.Transpose(Tb)
                .TextToColumns Destination:=.Cells(1, 1), DataType:=xlDelimited, Comma:=True, FieldInfo:=Array(Array(1, 5), Array(2, 1), Array(3, 1))
            End With
        End With
    End If
Next i
 
IE.Quit
Set IE = Nothing
Set Req = Nothing
End Sub