Pilotage Internet Explorer

**itwoo** · 08/07/2014, 13h17

Bonjour à tous les deux,

Bien comme vous le proposez ca marche, c'est juste un peu long vu le nombre de requêtes...
c'est cool

Bonne continuation

**patricktoulon** · 09/07/2014, 12h09

Bonjour itwoo et qwazerrty

itwoo si tu fait une toute petite recherche dans les contribs tu trouvera un gars tres gentil qui t'a maché le travail
en effet il a trouvé le moyen d'acceler les multiple requette

et ca fonctionne nikel au moins 50% de temps gagné au minimum c'est top non?
ca parle d'abeilles .....ect
allez un tout petit effort tu trouvera

**Marc-L** · 09/07/2014, 12h32

Et dire que je n'y ai récolté - pour l'instant - que deux

‼

♫ Let it be, let it be, let it be, let it be ♪

**patricktoulon** · 09/07/2014, 13h09

re
c'est ici

salut marc je suis impardonable j'y retourne de ce pas pour mettre un bras tout entier

tu lui fait une adaptation ou je m y colle ?

♫ laisse beton , laisse beton , laisse beton , laisse beton ♪

**Marc-L** · 09/07/2014, 15h22

Merci Patrick !

Pas de souci pour que tu t'y colles car je n'ai guère suivi techniquement les besoins d'itwoo !

Et puis peut-être tu nous pondras une procédure un peu plus générique …

**Qwazerty** · 09/07/2014, 20h39

Salut

Sinon, une autre approche en utilisant la méthode Synchrone/Asynchrone fourni par la requête.
J'ai eu la flemme d'implémenter la partie enregistrement des données et il faudra faire quelques testes, je pense que dans le principe cela doit fonctionner.
Il faudra affiner le nombre de Demande total pouvant être faites simultanément, j'ai mis 20 requêtes (0 à 19) mais ça ne semble pas suffisant (petit mouchard bBut...).
Bien penser à changer la taille des tableaux DemandeFichier et TableSuivi pour ajouter des instance de Demande en plus grand nombre.
Il faudrait également implémenté quelques lignes de code en plus pour être sûr de ne pas rester bloqué dans une boucle Do Loop et peut-être placer quelques Sleep() pour calmer l'utilisation processeur (100ms c'est rien pour nous mais ça laisse un peu de temps au proc.).

[Edit] 20h53: Correction code

Il serait aussi possible d'adapter la taille des tableaux (DemandeFichier et TableSuivi) en fonction du nombre d'enregistrements à rapatrier en utilisant Redim Preserve à l’intérieur du

Code :

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

If Not NotFirstAsk Then

[/Edit]

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
Sub XMLReq_Euronext()
'cette sub va interroger le serveur pour récupérer toutes les données du jour
'Il faut activer la bibliotheque Microsoft WinHTTP Service
Dim DemandeFichier(19) As New MSXML2.XMLHTTP, URl As String
Dim TableSuivi(19) As Integer
Dim intDemande As Integer, intDebut As Integer
Dim x As Byte
Dim NbrRecord As Integer
Dim AllOk As Boolean
Dim NotFirstAsk As Boolean
Dim bBut As Boolean
Dim intStop As Integer
 
    URl = "https://europeanequities.nyx.com/pd/stocks/data?formKey=nyx_pd_filter_values:1006ef55d4998cc0fad71db6a6f38530"
   ' Application.ScreenUpdating = False
    NotFirstAsk = False 'La 1ère demande se fera en Synchrone pour connaitre le nombre d'élément avant de passer à la suite
 
    Do
        If intDebut <= NbrRecord Then
            'On génère la requête
            With DemandeFichier(intDemande)
                .Open "POST", URl, NotFirstAsk
                .setRequestHeader "Accept", "application/json, text/javascript, */*"
                .setRequestHeader "Accept-Encoding", "gzip , deflate"
                .setRequestHeader "Content-Type", "application/x-www-form-urlencoded; charset=UTF-8"  'Ajouté
                .setRequestHeader "Content-Length", "231"  'Ajouté
                .setRequestHeader "Cache-Control", "no-cache"  'Ajouté
                .setRequestHeader "Accept-Language", "fr,fr-fr;q=0.8,en-us;q=0.5,en;q=0.3"
                .setRequestHeader "Connection", "keep-alive" 'Modifié, espace retiré "keep -alive"
                .setRequestHeader "Host", "europeanequities.nyx.com"
                .setRequestHeader "Pragma", "no-cache"  'Ajouté
                .setRequestHeader "Referer", "https://europeanequities.nyx.com/fr/equities-directory"
                .setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.0; rv:29.0) Gecko/20100101 Firefox/29.0"
 
                'On l'exécute la requête (avec les parametres comme pour NASDAQ)
                .send "sEcho=6&iColumns=7&sColumns=&iDisplayStart=" & CStr(intDebut) & "&iDisplayLength=20&iSortingCols=1&iSortCol_0=0&sSortDir_0=asc&bSortable_0=true&bSortable_1=false&bSortable_2=false&bSortable_3=false&bSortable_4=false&bSortable_5=false&bSortable_6=false"
 
                'On met à jour les variables
                If Not NotFirstAsk Then
                    NotFirstAsk = True
                    NbrRecord = InStr(1, .responseText, "iTotalRecords"":") + 15
                    NbrRecord = CInt(Mid(.responseText, NbrRecord, InStr(NbrRecord, .responseText, ",") - NbrRecord))
                End If
                TableSuivi(intDemande) = intDebut 'on note ce que cette demande va nous retourner quand elle sera à terme
                intDebut = intDebut + 20
 
            End With
        End If
 
        'On regarde si des demandes ont abouties
        AllOk = True
        intDemande = -1
        intStop = 0
        Do
            For x = 0 To UBound(DemandeFichier)
                If Not DemandeFichier(x) Is Nothing Then
                    If DemandeFichier(x).ReadyState = 4 Then
                        'Ici tu places du code pour prendre en compte le contenu de la réponse
                        'En utilisant le contenu du tableau de suivi pour savoir à partir de quelle ligne placer les données sur le feuille qui reçoit les résultats
                        'Feuil1.Cells(tablesuivi(x)+1,"A")....
                        Feuil1.Cells(TableSuivi(x) + 1, "A").Value = "OK - " & CStr(bBut)
                        'On instancie de nouveau l'objet
                        Set DemandeFichier(x) = CreateObject("Microsoft.XMLHTTP")
                        'Demande dispo
                        intDemande = x
                    ElseIf DemandeFichier(x).ReadyState = 0 Then
                        'La demande est libre on la défini comme étant la prochiane à être utilisée
                        intDemande = x
                    Else
                        'Une demande est en cours
                        AllOk = False
                    End If
                End If
            Next
            'Juste pour voir si le nombre d'instance de Demande est suffisant
            bBut = intDemande = -1
            DoEvents
           ' intStop = intStop + 1 'avec un espion qui stop quand intstop = 32000
        Loop While intDemande = -1
        DoEvents
    Loop Until AllOk And intDebut > NbrRecord
 
End Sub

++
Qwaz

**patricktoulon** · 10/07/2014, 00h37

salut qwazerty

si on examine ton code avec les doevents on fait presque la meme chose que marc avec les multiple requetes en vbs

mais sans doute a cause de l'application elle meme on se rend compte que la consomation UC est 4 fois plus importante en terme de memoire et processeur

sans doute parceque de toute maniere il faut attendre la releve du doevent a chaque fois quand meme ce qui implique effectivement le bousculage du processeur meme si la on parle de milieme de miileme de seconde alors les sleep effectivement redescende la cadence mais rallonge la procedure
a la difference de 10 instence du vbs bien moins lourd que 10 boucle avec sleep et doevents dans l'application elle meme
les deux solutions sont a essayer je vais m'y coller demain maintenant je dors

**patricktoulon** · 13/07/2014, 22h06

bonjour itwoo et marc
puré de puré

moins de 9 secondes pour tout récupérer trier, parser ,tabler
au puré !!!!

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
107
108
109
110
111
112
Sub XMLReq_Euronext()
debut = Time
Columns("A:G").ClearContents
'cette sub va interroger le serveur pour récupérer toutes les données du jour
'Il faut activer la bibliothèque Microsoft WinHTTP Service
     Application.ScreenUpdating = False
    Dim DemandeFichier As Object, URL As String
    Dim FSys As Object, MonFic
    Dim texte As String
    Set DemandeFichier = CreateObject("Microsoft.XMLHTTP")  'instancie l'object
      URL = "https://europeanequities.nyx.com/pd/stocks/data?formKey=nyx_pd_filter_values:1006ef55d4998cc0fad71db6a6f38530"
    'On génère la 1 ere requête afin d'obtenir les 20  1ere ligne ainsi que le nombre de page
    DemandeFichier.Open "POST", URL, False
    DemandeFichier.setRequestHeader "Accept", "application/json, text/javascript, */*"
    DemandeFichier.setRequestHeader "Accept-Encoding", "gzip , deflate"
    DemandeFichier.setRequestHeader "Content-Type", "application/x-www-form-urlencoded; charset=UTF-8"  'Ajouté
    DemandeFichier.setRequestHeader "Content-Length", "231"  'Ajouté
    DemandeFichier.setRequestHeader "Cache-Control", "no-cache"  'Ajouté
    DemandeFichier.setRequestHeader "Accept-Language", "fr,fr-fr;q=0.8,en-us;q=0.5,en;q=0.3"
    DemandeFichier.setRequestHeader "Connection", "keep-alive" 'Modifié, espace retiré "keep -alive"
    DemandeFichier.setRequestHeader "Host", "europeanequities.nyx.com"
    DemandeFichier.setRequestHeader "Pragma", "no-cache"  'Ajouté
    DemandeFichier.setRequestHeader "Referer", "https://europeanequities.nyx.com/fr/equities-directory"
    DemandeFichier.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.0; rv:29.0) Gecko/20100101 Firefox/29.0"
 'on envoie la requete avec un idisplaystart= a 0
       DemandeFichier.send "sEcho=5&iColumns=7&sColumns=&iDisplayStart=0&iDisplayLength=20&iSortingCols=1&iSortCol_0=0&sSortDir_0=asc&bSortable_0=true&bSortable_1=false&bSortable_2=false&bSortable_3=false&bSortable_4=false&bSortable_5=false&bSortable_6=false"
 
 ' on détermine le nombre de page a télécharger en récupérant le iTotalRecords dans la première page et en divisant par 20
 NBPAGES = Round(Val(Split(Split(DemandeFichier.responseText, "iTotalRecords"":")(1), ",")(0)) / 20)
 
 'on a executer une requette presque pour rien me dira tu
 'mais il n'en est rien ,en fait la premiere requete est excecutée pour determiner le nombre de page
 ' on va créer un dossier pour y placer toutes les requete en.vbs
 On Error Resume Next
 MkDir "c:\tempvbs"
 Err.Clear
 'on lance la procedure autant de fois que de page
  For i = 0 To NBPAGES   'enleve le 5 et debloque nbpages pour la totale
 ' et c'est dans cette boucle que tout ce joue
 'on changera les argument ici et plus en dur comme il est necessaire dans le code let it be
  'dans l'exemple d'aujourdhui pour itwoo c'est dans le send qu'il y a des changement
  argument_du_send = """sEcho=5&iColumns=7&sColumns=&iDisplayStart=" & i * 20 & "&iDisplayLength=20&iSortingCols=1&iSortCol_0=0&sSortDir_0=asc&bSortable_0=true&bSortable_1=false&bSortable_2=false&bSortable_3=false&bSortable_4=false&bSortable_5=false&bSortable_6=false"""
 
  'appelle la creation de la requete avec ces arguments
   creationvbs URL, argument_du_send, i, i * 20 + i + 1
 
  Next
  MsgBox "Operation commencée a : " & debut & vbCrLf & "elle c'est terminée a : " & Time
 Dim fso As New FileSystemObject
   On Error Resume Next
fso.DeleteFolder ("c:\tempvbs")
 
  End Sub
 
 
 
  Sub creationvbs(URL As String, Optional argument_du_send = "", Optional i = 0, Optional lig = 0)
   texte = "dim tablo,tablo2(20,7)" & vbCrLf
   texte = texte & vbCrLf & "Set DemandeFichier = CreateObject(""Microsoft.XMLHTTP"")"
   texte = texte & vbCrLf & "DemandeFichier.Open ""POST" & """, """ & URL & """," & " False"
 
   Header = "DemandeFichier.setRequestHeader ""Accept"", ""application/json, text/javascript, */*""" & vbCrLf & _
    "DemandeFichier.setRequestHeader ""Accept-Encoding"", ""gzip , deflate""" & vbCrLf & _
    "DemandeFichier.setRequestHeader ""Content-Type"", ""application/x-www-form-urlencoded; charset=UTF-8""" & vbCrLf & _
    "DemandeFichier.setRequestHeader ""Content-Length"", ""231""" & vbCrLf & _
    "DemandeFichier.setRequestHeader ""Cache-Control"", ""no-cache""" & vbCrLf & _
    "DemandeFichier.setRequestHeader ""Accept-Language"", ""fr,fr-fr;q=0.8,en-us;q=0.5,en;q=0.3""" & vbCrLf & _
    "DemandeFichier.setRequestHeader ""Connection"", ""keep-alive""" & vbCrLf & _
    "DemandeFichier.setRequestHeader ""Host"", ""europeanequities.nyx.com""" & vbCrLf & _
    "DemandeFichier.setRequestHeader ""Pragma"", ""no-cache""" & vbCrLf & _
    "DemandeFichier.setRequestHeader ""Referer"", ""https://europeanequities.nyx.com/fr/equities-directory""" & vbCrLf & _
    "DemandeFichier.setRequestHeader ""User-Agent"", ""Mozilla/5.0 (Windows NT 6.0; rv:29.0) Gecko/20100101 Firefox/29.0"""
   envoie = "DemandeFichier.send " & argument_du_send
 
 
    argumentfinal = "GetObject(, ""Excel.Application"").Workbooks(""itwoo.xls"").Worksheets(1).Range(""A" & lig & """).Resize(UBound(tablo2), 7) = tablo2"
parser = "resultat = Replace(DemandeFichier.responseText, ""["", vbCrLf)" & vbCrLf & _
"tablo = Split(resultat, vbCrLf)" & vbCrLf & "Z = 0" & vbCrLf & _
"For i = 2 To UBound(tablo)" & vbCrLf & _
"tablo2(Z, 0) = Split(Split(tablo(i), ""\u003e"")(1), ""\"")(0)" & vbCrLf & _
"tablo(i) = Split(Split(tablo(i), ""/div\u003e"""","""""")(1), ""]"")(0)" & vbCrLf & _
"tablo2(Z, 1) = Split(tablo(i), """""","""""")(0)" & vbCrLf & _
"tablo2(Z, 2) = Split(tablo(i), """""","""""")(1)" & vbCrLf & _
"tablo2(Z, 3) = Split(tablo(i), """""","""""")(2)" & vbCrLf & _
"tablo2(Z, 4) = Split(tablo(i), """""","""""")(3)" & vbCrLf & _
"tablo2(Z, 6) = Replace(Split(tablo(i), """""","""""")(5), Chr(34),"""")" & vbCrLf & _
"On Error Resume Next" & vbCrLf & _
"tablo2(Z, 5) = Split(Split(tablo(i), ""\u003e"")(1), ""\"")(0)" & vbCrLf & _
"Err.Clear" & vbCrLf & _
"Z = Z + 1" & vbCrLf & _
"Next"
 
texte = texte & vbCrLf & Header & vbCrLf & envoie & vbCrLf & parser & vbCrLf & argumentfinal
      'On copie les données dans un fichier
    Set FSys = CreateObject("Scripting.FileSystemObject")
    Set MonFic = FSys.CreateTextFile("c:\tempvbs\page" & i + 1 & ".vbs")
    With MonFic 'Pour écrire dans le fichier texte
        .write texte
    End With
 'on va maintenant lancer l'execution des/ou de la   requete vbs
lancement_requete_externe "c:\tempvbs\page" & i + 1 & ".vbs", decompte * 20
     End Sub
Sub lancement_requete_externe(requeteX, indexligne)
With CreateObject("WScript.Shell")
 
            'If Cells(indexligne, 1).Value = "" Then
                .Run requeteX
 
            'End If
 
    End With
End Sub

**Qwazerty** · 14/07/2014, 08h34

Salut

Je n'ai pas vérifié mes propos mais, 9 secondes pour lancer toutes les requêtes, mais les données ne sont pas encore dans le classeur

.
D'ailleurs, le On error resume next de la fin, je suppose que tu l'as mis car le deletefolder qui suit devait générer une erreur et donc je présume aussi qu'à la fin de ta macro, le dossier et toutes les requêtes restent sur le DD ?

De mon coté il faut 2min (je viens de faire le teste) pour avoir la réponse de toutes les requêtes, j'ai mis 90 "DemandeFichier" pour être sûr de ne pas saturer. Je pense qu'il est possible de gratter un peu en améliorant le système de boucle mais bon ça n’enlèvera pas une minute.
Bien sûr le traitement en série des requête que fait mon code, sera toujours plus lent qu'un traitement parallèle effectué par le votre, mais je serais curieux de savoir le vrai écart entre les 2 méthodes, pas facile de savoir à quel moment toute les requêtes sont finies dans votre cas, il faudrait ajouter une petite ligne dans le corps du vbs pour que l'heure soit notée avec les données et ainsi chercher à la fin l'heure de la dernière réponse aux requêtes.

++
Qwaz

**Marc-L** · 14/07/2014, 12h25

Ma contribution informe du temps d'exécution en gérant - un seul fichier .vbs générique - le retour des requêtes
via l'évènement Worksheet_Change … Patrick a plutôt élagué l'idée mais a le mérite d'aller au plus simple !

Moins l'ordinateur est puissant plus le gain de temps via cette méthode multi-requêtes vbs est appréciable …

__________________________________________________________________________________________
Définition Orteil : appendice servant à détecter les coins de portes !

**patricktoulon** · 14/07/2014, 12h43

bonjour a tous les deux

qwazerty non les fichiers ne restent pas sur le disque dur normalement mais le cas échéant en cas de non effacement du a une autorité sur sur le disque j'ai préféré le laisser cela dit je referais proprement ca avec une fonction folderexist

et oui chez moi sur mon pc portable ca met bien 9 secondes pour tout récupérer les donnée sont bien la mais comme il y a le screenupdating a false tu ne le voit pas avant d'avoir cliqué sur le msgbox de fin

marc je ne l'ai pas élagué j'ai bien essayer une version basique avec un seul fichier mais c'est quand même plus long justement a cause des fonctions du worksheet qui servent en quelque sorte de control pour les abeilles manquantes

bon d'accords c'est une version pas bien fini mais je termine celle la avec les multiple fichier et après j'en fait une au propre avec 1 seul fichier vbs

c'est pas le plus important ce que je vais essayé de faire maintenant c'est bien séparé les argument pour que la fonction de génération soit le plus générique au possible mais bon avec les colles d'itwoo c'est jamais simple

je vais séparer aussi le parseur car il est trop personnel mais ca n'est pas facile on est en vbs (externe )

je vais sans dout utiliser l'argumentation comme le fait marc en vba l'ors du lancement du vbs

la différence de temps est monstrueuse avec ma version vba plus haut ca n'a rien de comparable Excel est mono tache

a mouins de faire une classe requête je 'y avais pas pensé

et dans ce cas précis il y a 74 requêtes elles sont bien exécutées en 9/10 secondes j'ai perdu 1 a 2 secondes en remettant le screenupdating a true avant le msgbox
mais a ce niveau de performance personne ne va se plaindre je crois
Nom : Capture.JPG
Affichages : 177
Taille : 400,1 Ko

Nom : Capture.JPG
Affichages : 177
Taille : 400,1 Ko

a au fait est ce que l'un de vous deux connais la marche a suivre pour pouvoir utiliser smart indenter

je l'avais et l'ors d'un formatage complet est réinstallation Windows je l'ai remis mais il n'apparait pas dans le menu contextuel de l'éditeur vbe

j'ai lu partout que ca ne fonctionnait pas en 64 bits

mais j'ai toujours eu W7 64 bit et office 32 bits je n'ai rien changé
ca m'ennuie fortement c'est quand même un bon outils

**patricktoulon** · 14/07/2014, 14h31

c'est bon j'ai résolu le soucis avec smart indenter
en fait la dernière version 3.5 est plein de soucis apparemment j'ai retrouver dans mes archives la version que j'avais télécharger ici même en 2012

donc il est dit partout que ca ne fonctionne pas avec W 7 64 et office 32 bits et bien c'est faux
celui qui voudrais cette old version peut m'en faire la demande

voila le code au propre et indenter
'option explicit toute les variables sont déclarées
j'ai supprimer la gestion d'erreur sur le folder il y a maintenant la fonction folder_exist

et ca fait toujourss entre 9 et 11 secondes de temps de fonctionnement

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
Option Explicit
Sub XMLReq_Euronext()
    Dim debut, NBPAGES As Long, i As Long, ARGTS_send As String, Fso As Object
    debut = Time
    Columns("A:G").ClearContents
    'cette sub va interroger le serveur pour récupérer toutes les données du jour
    'Il faut activer la bibliothèque Microsoft WinHTTP Service
    Application.ScreenUpdating = False
    Dim DemandeFichier As Object, URL As String
    Dim FSys As Object, MonFic
    Dim texte As String
    Set DemandeFichier = CreateObject("Microsoft.XMLHTTP")  'instancie l'object
    URL = "<a href="https://europeanequities.nyx.com/pd/stocks/data?formKey=nyx_pd_filter_values:1006ef55d4998cc0fad71db6a6f38530" target="_blank">https://europeanequities.nyx.com/pd/...d71db6a6f38530</a>"
    'On génère la 1 ere requête afin d'obtenir les 20  1ere ligne ainsi que le nombre de page
    DemandeFichier.Open "POST", URL, False
    DemandeFichier.setRequestHeader "Accept", "application/json, text/javascript, */*"
    DemandeFichier.setRequestHeader "Accept-Encoding", "gzip , deflate"
    DemandeFichier.setRequestHeader "Content-Type", "application/x-www-form-urlencoded; charset=UTF-8"  'Ajouté
    DemandeFichier.setRequestHeader "Content-Length", "231"  'Ajouté
    DemandeFichier.setRequestHeader "Cache-Control", "no-cache"  'Ajouté
    DemandeFichier.setRequestHeader "Accept-Language", "fr,fr-fr;q=0.8,en-us;q=0.5,en;q=0.3"
    DemandeFichier.setRequestHeader "Connection", "keep-alive"    'Modifié, espace retiré "keep -alive"
    DemandeFichier.setRequestHeader "Host", "europeanequities.nyx.com"
    DemandeFichier.setRequestHeader "Pragma", "no-cache"  'Ajouté
    DemandeFichier.setRequestHeader "Referer", "<a href="https://europeanequities.nyx.com/fr/equities-directory" target="_blank">https://europeanequities.nyx.com/fr/equities-directory</a>"
    DemandeFichier.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.0; rv:29.0) Gecko/20100101 Firefox/29.0"
    'on envoie la requete avec un idisplaystart= a 0
    DemandeFichier.send "sEcho=5&iColumns=7&sColumns=&iDisplayStart=0&iDisplayLength=20&iSortingCols=1&iSortCol_0=0&sSortDir_0=asc&bSortable_0=true&bSortable_1=false&bSortable_2=false&bSortable_3=false&bSortable_4=false&bSortable_5=false&bSortable_6=false"
    ' on détermine le nombre de page a télécharger en récupérant le iTotalRecords dans la première page et en divisant par 20
    NBPAGES = Round(Val(Split(Split(DemandeFichier.responseText, "iTotalRecords"":")(1), ",")(0)) / 20)
    'on a executer une requette presque pour rien me dira tu
    'mais il n'en est rien ,en fait la premiere requete est excecutée pour determiner le nombre de page
    ' on va créer un dossier pour y placer toutes les requete en.vbs
    'On Error Resume Next
    If folder_exist("C:\tempvbs") = False Then MkDir "C:\tempvbs"
    Err.Clear
    'on lance la procedure autant de fois que de page
    For i = 0 To NBPAGES   'enleve le 5 et debloque nbpages pour la totale
        ' et c'est dans cette boucle que tout ce joue
        'on changera les argument ici et plus en dur comme il est necessaire dans le code let it be
        'dans l'exemple d'aujourdhui pour itwoo c'est dans le send qu'il y a des changement
        ARGTS_send = """sEcho=5&iColumns=7&sColumns=&iDisplayStart=" & i * 20 & "&iDisplayLength=20&iSortingCols=1&iSortCol_0=0&sSortDir_0=asc&bSortable_0=true&bSortable_1=false&bSortable_2=false&bSortable_3=false&bSortable_4=false&bSortable_5=false&bSortable_6=false"""
        'appelle la creation de la requete avec ces arguments
        creationvbs URL, ARGTS_send, i, i * 20 + i + 1
    Next
    Application.ScreenUpdating = True
    MsgBox "Operation commencée a : " & debut & vbCrLf & "elle c'est terminée a : " & Time
    Set Fso = New Scripting.FileSystemObject
    If folder_exist("C:\tempvbs") = True Then Fso.DeleteFolder ("c:\tempvbs")
 
End Sub
 
Sub creationvbs(URL As String, Optional argument_du_send = "", Optional i = 0, Optional lig = 0)
    Dim texte As String, Header As String, sending As String, Réinjection As String, Parser As String, FSys As Object, MonFic As Object
    texte = "dim tablo,tablo2(20,7)" & vbCrLf
    texte = texte & vbCrLf & "Set DemandeFichier = CreateObject(""Microsoft.XMLHTTP"")"
    texte = texte & vbCrLf & "DemandeFichier.Open ""POST" & """, """ & URL & """," & " False"
    Header = "DemandeFichier.setRequestHeader ""Accept"", ""application/json, text/javascript, */*""" & vbCrLf & _
             "DemandeFichier.setRequestHeader ""Accept-Encoding"", ""gzip , deflate""" & vbCrLf & _
             "DemandeFichier.setRequestHeader ""Content-Type"", ""application/x-www-form-urlencoded; charset=UTF-8""" & vbCrLf & _
             "DemandeFichier.setRequestHeader ""Content-Length"", ""231""" & vbCrLf & _
             "DemandeFichier.setRequestHeader ""Cache-Control"", ""no-cache""" & vbCrLf & _
             "DemandeFichier.setRequestHeader ""Accept-Language"", ""fr,fr-fr;q=0.8,en-us;q=0.5,en;q=0.3""" & vbCrLf & _
             "DemandeFichier.setRequestHeader ""Connection"", ""keep-alive""" & vbCrLf & _
             "DemandeFichier.setRequestHeader ""Host"", ""europeanequities.nyx.com""" & vbCrLf & _
             "DemandeFichier.setRequestHeader ""Pragma"", ""no-cache""" & vbCrLf & _
             "DemandeFichier.setRequestHeader ""Referer"", ""<a href="https://europeanequities.nyx.com/fr/equities-directory" target="_blank">https://europeanequities.nyx.com/fr/equities-directory</a>""" & vbCrLf & _
             "DemandeFichier.setRequestHeader ""User-Agent"", ""Mozilla/5.0 (Windows NT 6.0; rv:29.0) Gecko/20100101 Firefox/29.0"""
    sending = "DemandeFichier.send " & argument_du_send
 
    Réinjection = "GetObject(, ""Excel.Application"").Workbooks(""" & ThisWorkbook.Name & """).Worksheets(1).Range(""A" & lig & """).Resize(UBound(tablo2), 7) = tablo2"
    Parser = "resultat = Replace(DemandeFichier.responseText, ""["", vbCrLf)" & vbCrLf & _
             "tablo = Split(resultat, vbCrLf)" & vbCrLf & "Z = 0" & vbCrLf & _
             "For i = 2 To UBound(tablo)" & vbCrLf & _
             "tablo2(Z, 0) = Split(Split(tablo(i), ""\u003e"")(1), ""\"")(0)" & vbCrLf & _
             "tablo(i) = Split(Split(tablo(i), ""/div\u003e"""","""""")(1), ""]"")(0)" & vbCrLf & _
             "tablo2(Z, 1) = Split(tablo(i), """""","""""")(0)" & vbCrLf & _
             "tablo2(Z, 2) = Split(tablo(i), """""","""""")(1)" & vbCrLf & _
             "tablo2(Z, 3) = Split(tablo(i), """""","""""")(2)" & vbCrLf & _
             "tablo2(Z, 4) = Split(tablo(i), """""","""""")(3)" & vbCrLf & _
             "tablo2(Z, 6) = Replace(Split(tablo(i), """""","""""")(5), Chr(34),"""")" & vbCrLf & _
             "On Error Resume Next" & vbCrLf & _
             "tablo2(Z, 5) = Split(Split(tablo(i), ""\u003e"")(1), ""\"")(0)" & vbCrLf & _
             "Err.Clear" & vbCrLf & _
             "Z = Z + 1" & vbCrLf & _
             "Next"
    texte = texte & vbCrLf & Header & vbCrLf & sending & vbCrLf & Parser & vbCrLf & Réinjection
    'On copie le code dans un fichier
    Set FSys = CreateObject("Scripting.FileSystemObject")
    Set MonFic = FSys.CreateTextFile("c:\tempvbs\page" & i + 1 & ".vbs")
    With MonFic    'Pour écrire dans le fichier texte
        .write texte
    End With
    'on va maintenant lancer l'execution des/ou de la   requete vbs
    lancement_requete_externe "c:\tempvbs\page" & i + 1 & ".vbs", i * 20
End Sub
Sub lancement_requete_externe(requeteX, indexligne)
    With CreateObject("WScript.Shell")
        .Run requeteX
       End With
End Sub
Function folder_exist(snamedossier)
    Dim oFSO
    Set oFSO = New Scripting.FileSystemObject
    folder_exist = oFSO.FolderExists(snamedossier)
End Function

c'est itwoo qui va être content

**patricktoulon** · 15/07/2014, 14h05

salut marc

voila une version utilisant un seul vbs dans le quel j'injecte 3 arguments a chaque fois et tu constatera que c'est 5 a 6 fois plus lent et en plus il y a des ratés

il y a donc bien une incidence sur l'utilisation du même fichier en multitâche(X instance)

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
 
Sub EURONEXT_ALL_EQUITIES()
    Dim debut, NBPAGES As Long, i As Long, ARGTS_send As String, Fso As Object
    debut = Time
    pageblanche 1    ' le 1 peut etre remplacé par le vrai nom du sheets
    'cette sub va interroger le serveur pour récupérer toutes les données du jour
    'Il faut activer la bibliothèque Microsoft WinHTTP Service
    Application.ScreenUpdating = False
    Dim DemandeFichier As Object, URL As String
    Dim FSys As Object, MonFic
    Dim texte As String
    Set DemandeFichier = CreateObject("Microsoft.XMLHTTP")  'instancie l'object
    URL = "https://europeanequities.nyx.com/pd/stocks/data?formKey=nyx_pd_filter_values:1006ef55d4998cc0fad71db6a6f38530"
    'On génère la 1 ere requête afin d'obtenir les 20  1ere ligne ainsi que le nombre de page
    DemandeFichier.Open "POST", URL, False
    DemandeFichier.setRequestHeader "Accept", "application/json, text/javascript, */*"
    DemandeFichier.setRequestHeader "Accept-Encoding", "gzip , deflate"
    DemandeFichier.setRequestHeader "Content-Type", "application/x-www-form-urlencoded; charset=UTF-8"  'Ajouté
    DemandeFichier.setRequestHeader "Content-Length", "231"  'Ajouté
    DemandeFichier.setRequestHeader "Cache-Control", "no-cache"  'Ajouté
    DemandeFichier.setRequestHeader "Accept-Language", "fr,fr-fr;q=0.8,en-us;q=0.5,en;q=0.3"
    DemandeFichier.setRequestHeader "Connection", "keep-alive"    'Modifié, espace retiré "keep -alive"
    DemandeFichier.setRequestHeader "Host", "europeanequities.nyx.com"
    DemandeFichier.setRequestHeader "Pragma", "no-cache"  'Ajouté
    DemandeFichier.setRequestHeader "Referer", "https://europeanequities.nyx.com/fr/equities-directory"
    DemandeFichier.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.0; rv:29.0) Gecko/20100101 Firefox/29.0"
    'on envoie la requete avec un idisplaystart= a 0
    DemandeFichier.send "sEcho=5&iColumns=7&sColumns=&iDisplayStart=0&iDisplayLength=20&iSortingCols=1&iSortCol_0=0&sSortDir_0=asc&bSortable_0=true&bSortable_1=false&bSortable_2=false&bSortable_3=false&bSortable_4=false&bSortable_5=false&bSortable_6=false"
    ' on détermine le nombre de page a télécharger en récupérant le iTotalRecords dans la première page et en divisant par 20
    NBPAGES = Round(Val(Split(Split(DemandeFichier.responseText, "iTotalRecords"":")(1), ",")(0)) / 20)
    'on a executer une requette presque pour rien me dira tu
    'mais il n'en est rien ,en fait la premiere requete est excecutée pour determiner le nombre de page
 
    creationvbs2
 
    URL = "https://europeanequities.nyx.com/pd/stocks/data?formKey=nyx_pd_filter_values:1006ef55d4998cc0fad71db6a6f38530"
 
requetevbs = ThisWorkbook.Path & "\requeteallequities" & ".vbs"
SC = """" & requetevbs & """ "
    For i = 0 To NBPAGES
        ARGsending = i * 20
        firstcel = i * 20 + i + 1
With CreateObject("WScript.Shell")
 
            .Run SC & URL & " " & ARGsending & " " & firstcel
        End With
 
    Next
End Sub
'/////////////////////////////////////////////////////////////////////////////////////////////////////////// '///////////////////////////////////////////////////////////////////////////////////////////////////////////
'///////////////////////////////////////////////////////////////////////////////////////////////////////////
 
Sub creationvbs2()
    Dim texte As String, Header As String, sending As String, Réinjection As String, Parser As String, FSys As Object, MonFic As Object
    texte = "dim tablo,tablo2(20,7)" & vbCrLf
    texte = texte & vbCrLf & "Set DemandeFichier = CreateObject(""Microsoft.XMLHTTP"")"
    texte = texte & vbCrLf & "DemandeFichier.Open ""POST" & """, WScript.Arguments(0), False"
    Header = "DemandeFichier.setRequestHeader ""Accept"", ""application/json, text/javascript, */*""" & vbCrLf & _
             "DemandeFichier.setRequestHeader ""Accept-Encoding"", ""gzip , deflate""" & vbCrLf & _
             "DemandeFichier.setRequestHeader ""Content-Type"", ""application/x-www-form-urlencoded; charset=UTF-8""" & vbCrLf & _
             "DemandeFichier.setRequestHeader ""Content-Length"", ""231""" & vbCrLf & _
             "DemandeFichier.setRequestHeader ""Cache-Control"", ""no-cache""" & vbCrLf & _
             "DemandeFichier.setRequestHeader ""Accept-Language"", ""fr,fr-fr;q=0.8,en-us;q=0.5,en;q=0.3""" & vbCrLf & _
             "DemandeFichier.setRequestHeader ""Connection"", ""keep-alive""" & vbCrLf & _
             "DemandeFichier.setRequestHeader ""Host"", ""europeanequities.nyx.com""" & vbCrLf & _
             "DemandeFichier.setRequestHeader ""Pragma"", ""no-cache""" & vbCrLf & _
             "DemandeFichier.setRequestHeader ""Referer"", ""https://europeanequities.nyx.com/fr/equities-directory""" & vbCrLf & _
             "DemandeFichier.setRequestHeader ""User-Agent"", ""Mozilla/5.0 (Windows NT 6.0; rv:29.0) Gecko/20100101 Firefox/29.0""" & vbCrLf
ARGTS_send = """sEcho=5&iColumns=7&sColumns=&iDisplayStart=""" & "& WScript.Arguments(1) & " & """&iDisplayLength=20&iSortingCols=1&iSortCol_0=0&sSortDir_0=asc&bSortable_0=true&bSortable_1=false&bSortable_2=false&bSortable_3=false&bSortable_4=false&bSortable_5=false&bSortable_6=false"""
      Header = Header & "DemandeFichier.send " & ARGTS_send
    Réinjection = "GetObject(, ""Excel.Application"").Workbooks(""" & ThisWorkbook.Name & """).Worksheets(1).Range(""A"" & WScript.Arguments(2)).Resize(UBound(tablo2), 7) = tablo2"
    Parser = "resultat = Replace(DemandeFichier.responseText, ""["", vbCrLf)" & vbCrLf & _
             "tablo = Split(resultat, vbCrLf)" & vbCrLf & "Z = 0" & vbCrLf & _
             "For i = 2 To UBound(tablo)" & vbCrLf & _
             "tablo2(Z, 0) = Split(Split(tablo(i), ""\u003e"")(1), ""\"")(0)" & vbCrLf & _
             "tablo(i) = Split(Split(tablo(i), ""/div\u003e"""","""""")(1), ""]"")(0)" & vbCrLf & _
             "tablo2(Z, 1) = Split(tablo(i), """""","""""")(0)" & vbCrLf & _
             "tablo2(Z, 2) = Split(tablo(i), """""","""""")(1)" & vbCrLf & _
             "tablo2(Z, 3) = Split(tablo(i), """""","""""")(2)" & vbCrLf & _
             "tablo2(Z, 4) = Split(tablo(i), """""","""""")(3)" & vbCrLf & _
             "tablo2(Z, 6) = Replace(Split(tablo(i), """""","""""")(5), Chr(34),"""")" & vbCrLf & _
             "On Error Resume Next" & vbCrLf & _
             "tablo2(Z, 5) = Split(Split(tablo(i), ""\u003e"")(1), ""\"")(0)" & vbCrLf & _
             "Err.Clear" & vbCrLf & _
             "Z = Z + 1" & vbCrLf & _
             "Next"
    texte = texte & vbCrLf & Header & vbCrLf & sending & vbCrLf & Parser & vbCrLf & Réinjection
    With ThisWorkbook
        'On copie le code dans un fichier
        Set FSys = CreateObject("Scripting.FileSystemObject")
        Set MonFic = FSys.CreateTextFile(.Path & "\requeteallequities" & ".vbs")
        With MonFic    'Pour écrire dans le fichier texte
            .write texte
        End With
    End With
End Sub

**patricktoulon** · 15/07/2014, 14h31

je n'avais pas mis dans ce model le msgbox pour la durée
je viens de le faire et surprise
le temps que ma mains glisse sur le tapis de la souris et mon doigt clique sur OK c'est bon
environ 7 secondes
la différence correspond a la durée de la création des 74 vbs dans l'autre model
et les raté était simplement le fait que le vbs va tellement vite que la mise ajour graphiquement a l'écran n'est pas complète tout simplement
je vais essayé de mettre un control avant ces petits raté dans le wbk.change

**Marc-L** · 15/07/2014, 16h11

Tu me rassures car ma procédure a déjà dépassé les quatre-vingts requêtes sans souci
ni de retour de problème de ceux l'utilisant sur un site étranger …

Bon, j'en connais un qui doit être content ‼

__________________________________________________________________________________________
Péniche : oune zizi portugaiche !

**patricktoulon** · 15/07/2014, 16h37

oui tu peut etre rassurer
et voila maintenant la next version
elle donne exactement le temps qui'il lui faut pour avoir toutes les requetes inscrites et visibles sur le sheet

en fait je n'y était pas loin avec ma varible debut et time mais elle n'était pas au bon endroit

j'ai donc mis en public la variable debut et la variables nbpages ,j'en ai ajouté une comptechangement en public aussi
code du modul standard

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
 
Public comptechangement
Public NBPAGES As Long
Public debut 
Sub EURONEXT_ALL_EQUITIES()
    Dim i As Long, ARGTS_send As String, Fso As Object
NBPAGES = 0
    debut = Time
   comptechangement = 0
 pageblanche 1    ' le 1 peut etre remplacé par le vrai nom du sheets
    'cette sub va interroger le serveur pour récupérer toutes les données du jour
    'Il faut activer la bibliothèque Microsoft WinHTTP Service
    Application.ScreenUpdating = False
    Dim DemandeFichier As Object, URL As String
    Dim FSys As Object, MonFic
    Dim texte As String
    Set DemandeFichier = CreateObject("Microsoft.XMLHTTP")  'instancie l'object
    URL = "https://europeanequities.nyx.com/pd/stocks/data?formKey=nyx_pd_filter_values:1006ef55d4998cc0fad71db6a6f38530"
    'On génère la 1 ere requête afin d'obtenir les 20  1ere ligne ainsi que le nombre de page
    DemandeFichier.Open "POST", URL, False
    DemandeFichier.setRequestHeader "Accept", "application/json, text/javascript, */*"
    DemandeFichier.setRequestHeader "Accept-Encoding", "gzip , deflate"
    DemandeFichier.setRequestHeader "Content-Type", "application/x-www-form-urlencoded; charset=UTF-8"  'Ajouté
    DemandeFichier.setRequestHeader "Content-Length", "231"  'Ajouté
    DemandeFichier.setRequestHeader "Cache-Control", "no-cache"  'Ajouté
    DemandeFichier.setRequestHeader "Accept-Language", "fr,fr-fr;q=0.8,en-us;q=0.5,en;q=0.3"
    DemandeFichier.setRequestHeader "Connection", "keep-alive"    'Modifié, espace retiré "keep -alive"
    DemandeFichier.setRequestHeader "Host", "europeanequities.nyx.com"
    DemandeFichier.setRequestHeader "Pragma", "no-cache"  'Ajouté
    DemandeFichier.setRequestHeader "Referer", "https://europeanequities.nyx.com/fr/equities-directory"
    DemandeFichier.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.0; rv:29.0) Gecko/20100101 Firefox/29.0"
    'on envoie la requete avec un idisplaystart= a 0
    DemandeFichier.send "sEcho=5&iColumns=7&sColumns=&iDisplayStart=0&iDisplayLength=20&iSortingCols=1&iSortCol_0=0&sSortDir_0=asc&bSortable_0=true&bSortable_1=false&bSortable_2=false&bSortable_3=false&bSortable_4=false&bSortable_5=false&bSortable_6=false"
    ' on détermine le nombre de page a télécharger en récupérant le iTotalRecords dans la première page et en divisant par 20
    NBPAGES = Round(Val(Split(Split(DemandeFichier.responseText, "iTotalRecords"":")(1), ",")(0)) / 20)
    'on a executer une requette presque pour rien me dira tu
    'mais il n'en est rien ,en fait la premiere requete est excecutée pour determiner le nombre de page
 
    creationvbs2
 
    URL = "https://europeanequities.nyx.com/pd/stocks/data?formKey=nyx_pd_filter_values:1006ef55d4998cc0fad71db6a6f38530"
 
requetevbs = ThisWorkbook.Path & "\requeteallequities" & ".vbs"
debut = Time
SC = """" & requetevbs & """ "
    For i = 0 To NBPAGES
 
 
        ARGsending = i * 20
        firstcel = i * 20 + i + 1
With CreateObject("WScript.Shell")
 
            .Run SC & URL & " " & ARGsending & " " & firstcel
        End With
 
    Next
Application.ScreenUpdating = True
'MsgBox "operation comencée a : " & debut & vbCrLf & "elle c'est terminée a : " & Time & vbCrLf & "elle aura  durré : " & Format(Time - debut, "nn:ss")
End Sub
'/////////////////////////////////////////////////////////////////////////////////////////////////////////// '///////////////////////////////////////////////////////////////////////////////////////////////////////////
'///////////////////////////////////////////////////////////////////////////////////////////////////////////
 
Sub creationvbs2()
    Dim texte As String, Header As String, sending As String, Réinjection As String, Parser As String, FSys As Object, MonFic As Object
    texte = "dim tablo,tablo2(20,7)" & vbCrLf
    texte = texte & vbCrLf & "Set DemandeFichier = CreateObject(""Microsoft.XMLHTTP"")"
    texte = texte & vbCrLf & "DemandeFichier.Open ""POST" & """, WScript.Arguments(0), False"
    Header = "DemandeFichier.setRequestHeader ""Accept"", ""application/json, text/javascript, */*""" & vbCrLf & _
             "DemandeFichier.setRequestHeader ""Accept-Encoding"", ""gzip , deflate""" & vbCrLf & _
             "DemandeFichier.setRequestHeader ""Content-Type"", ""application/x-www-form-urlencoded; charset=UTF-8""" & vbCrLf & _
             "DemandeFichier.setRequestHeader ""Content-Length"", ""231""" & vbCrLf & _
             "DemandeFichier.setRequestHeader ""Cache-Control"", ""no-cache""" & vbCrLf & _
             "DemandeFichier.setRequestHeader ""Accept-Language"", ""fr,fr-fr;q=0.8,en-us;q=0.5,en;q=0.3""" & vbCrLf & _
             "DemandeFichier.setRequestHeader ""Connection"", ""keep-alive""" & vbCrLf & _
             "DemandeFichier.setRequestHeader ""Host"", ""europeanequities.nyx.com""" & vbCrLf & _
             "DemandeFichier.setRequestHeader ""Pragma"", ""no-cache""" & vbCrLf & _
             "DemandeFichier.setRequestHeader ""Referer"", ""https://europeanequities.nyx.com/fr/equities-directory""" & vbCrLf & _
             "DemandeFichier.setRequestHeader ""User-Agent"", ""Mozilla/5.0 (Windows NT 6.0; rv:29.0) Gecko/20100101 Firefox/29.0""" & vbCrLf
ARGTS_send = """sEcho=5&iColumns=7&sColumns=&iDisplayStart=""" & "& WScript.Arguments(1) & " & """&iDisplayLength=20&iSortingCols=1&iSortCol_0=0&sSortDir_0=asc&bSortable_0=true&bSortable_1=false&bSortable_2=false&bSortable_3=false&bSortable_4=false&bSortable_5=false&bSortable_6=false"""
      Header = Header & "DemandeFichier.send " & ARGTS_send
    Réinjection = "GetObject(, ""Excel.Application"").Workbooks(""" & ThisWorkbook.Name & """).Worksheets(1).Range(""A"" & WScript.Arguments(2)).Resize(UBound(tablo2), 7) = tablo2"
    Parser = "resultat = Replace(DemandeFichier.responseText, ""["", vbCrLf)" & vbCrLf & _
             "tablo = Split(resultat, vbCrLf)" & vbCrLf & "Z = 0" & vbCrLf & _
             "For i = 2 To UBound(tablo)" & vbCrLf & _
             "tablo2(Z, 0) = Split(Split(tablo(i), ""\u003e"")(1), ""\"")(0)" & vbCrLf & _
             "tablo(i) = Split(Split(tablo(i), ""/div\u003e"""","""""")(1), ""]"")(0)" & vbCrLf & _
             "tablo2(Z, 1) = Split(tablo(i), """""","""""")(0)" & vbCrLf & _
             "tablo2(Z, 2) = Split(tablo(i), """""","""""")(1)" & vbCrLf & _
             "tablo2(Z, 3) = Split(tablo(i), """""","""""")(2)" & vbCrLf & _
             "tablo2(Z, 4) = Split(tablo(i), """""","""""")(3)" & vbCrLf & _
             "tablo2(Z, 6) = Replace(Split(tablo(i), """""","""""")(5), Chr(34),"""")" & vbCrLf & _
             "On Error Resume Next" & vbCrLf & _
             "tablo2(Z, 5) = Split(Split(tablo(i), ""\u003e"")(1), ""\"")(0)" & vbCrLf & _
             "Err.Clear" & vbCrLf & _
             "Z = Z + 1" & vbCrLf & _
             "Next"
    texte = texte & vbCrLf & Header & vbCrLf & sending & vbCrLf & Parser & vbCrLf & Réinjection
    With ThisWorkbook
        'On copie le code dans un fichier
        Set FSys = CreateObject("Scripting.FileSystemObject")
        Set MonFic = FSys.CreateTextFile(.Path & "\requeteallequities" & ".vbs")
        With MonFic    'Pour écrire dans le fichier texte
            .write texte
        End With
    End With
End Sub

et dans le module du sheets j'ai mis

Code :

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

1
2
3
4
5
6
7
8
 
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address <> "" And Target.Address <> oldtarget Then
comptechangement = comptechangement + 1
oldtarget = Target.Address
End If
If comptechangement = NBPAGES Then MsgBox "operation comencée a : " & debut & vbCrLf & "elle c'est terminée a : " & Time & vbCrLf & "elle aura  durré : " & Format(Time - debut, "nn:ss")
End Sub

tout bêtement si il n'y a pas autant de changement que de nbpages le msgbox n'apparait pas
ce qui me donne chez moi un temps rel de 18 secondes environ
moi j'en connais 2 qui vont être contents
1 qwazerty :il avais raison
2 itwoo il va rentrer de vacance avec module tout prêt

essaie le et dis moi ce que tu en pense

**patricktoulon** · 15/07/2014, 18h38

Péniche : oune zizi portugaiche !

Mais ou va tu les chercher !!!?

**Marc-L** · 15/07/2014, 18h53

Envoyé par patricktoulon

essaie le et dis moi ce que tu en pense

Patrick, tu aurais le code de « pageblanche » pour le test ?

__________________________________________________________________________________________
Aides internationales : aides payées par les pauvres des pays riches pour aider les riches des pays pauvres …

**patricktoulon** · 15/07/2014, 19h31

a oui c'est vrai il est dans le module multi vbs je suis bête

tient voila le fichier au final j'ai quand même laissé le module avec X vbs

**Marc-L** · 16/07/2014, 11h44

Fonctionne bien de mon côté sous Win 7 & 2003 : belle adaptation !

aussi à Stéphane (Qwazerty) pour avoir éclairci l'horizon notamment avec son astuce du gif
mais surtout avec ses posts #130 en page 7 et #152 en page 8, merci !
J'ai pas encore regardé la partie EuroNext …

Sinon je suis tombé sur une page équivalente au NASDAQ mais là sans gif repère
et j'ai trouvé en pilotant IE comment attendre la fin de la mise à jour à coup sûr !
Le pire dans l'histoire, en reprenant ce fil à l'origine, Patrick dans ton post #15 tu étais vraiment proche !

C'est vraiment tout bête, c'est juste histoire de respecter la hiérarchie objet !
A suivre donc une adaptation épurée pour le NASDAQ …

__________________________________________________________________________________________
68km/h : limite de vitesse pour faire l'amour. Et oui à 69 on part en tête à queue !

Pilotage Internet Explorer

Macros et VBA Excel

Discussions similaires

Partager

Partager