QueryTables VS IE = CreateObject("internetexplorer.application")

**fifi5622** · 12/02/2017, 21h33

bonjour a tous

dans le but d'optimiser mon code vba

je cherche a remplacer mes querytables xlEntirePage par autres choses de plus rapide

lorsqu'il y a qu' une "table" a importer je me débrouille ( Merci a PatrickT. pour son outils iegetelementid ? ) tres pratique & simple

sauf que voila j'ai besoin d'autres infos " text " qui ne sont pas dans des "tables "
et plus que du sur-mesure je préfère du prêt a porter , c'est facilement modifiable et exploitable sur d'autres pages

donc je me suis dit je vais importer la page entière , ça fonctionne
il me suffira de faire quelques "split " pour exploiter mes données ensuite

Peux on importer la page entière et exploiter la table par la même occasion ( en 1 fois ) ?

j'ai fais quelques essais mais sans grande réussite

1er code pour importer text de la page - 2 imie code pour importer une table + essai avec .body.innerText sans reussite

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
 
Dim IE As InternetExplorer
Dim maPageHtml As HTMLDocument
 
Set IE = CreateObject("InternetExplorer.Application")
IE.Visible = False
 
IE.navigate "http://google.com"
    Do Until IE.readyState = READYSTATE_COMPLETE
    DoEvents
Loop
 
Text = IE.document.body.innerText

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
Sub testdt()
 
Columns("A:l").Clear
Dim ReQ As Object, UrL As String
UrL = "http://www.geny.com/partants-pmu/2015-05-19-longchamp-pmu-prix-des-gobelins_c714591"
Set ReQ = CreateObject("microsoft.xmlhttp")
ReQ.Open "POST", UrL, False
ReQ.setRequestHeader "Accept", "text/html, application/xhtml+xml, */*"
ReQ.setRequestHeader "Accept-Language", "fr-FR"
ReQ.setRequestHeader "User-Agent", "Mozilla/5.0 (compatible; MSIE 10.0; Windows NT 6.1; WOW64; Trident/6.0)"
ReQ.setRequestHeader "Accept-Encoding", "gzip, deflate"
ReQ.setRequestHeader "Host", "www.geny.com"
ReQ.setRequestHeader "DNT", 1
ReQ.setRequestHeader "Connection", "Keep - Alive"
ReQ.setRequestHeader "Cookie", " JSESSIONID=3E554B80B1ABBC36A2C53EC91C219C77.raoul_1;"
ReQ.send
'MsgBox ReQ.responsetext
 
 
 
Set fauxdoc = CreateObject("htmlfile")
With fauxdoc
 
'''body.innerText  = ReQ.responsetext  ??? 
 
.body.innerhtml = ReQ.responsetext
 
 
 
Set grouptable = .getelementsbytagname("TABLE")
For i = 0 To grouptable.Length - 1
If grouptable(i).ParentNode.ID = "dt_partants" Then Set matable = grouptable(i)
Next
For Each elem In matable.all
If elem.tagname = "TD" Then elem.innerhtml = elem.innerText
Next
faire = .ParentWindow.clipboardData.SetData("text", matable.outerhtml)
With Sheets(1)
Set cel = .Cells(Rows.Count, 1).End(xlUp).Offset(2, 0)
cel.Select
.Paste:
End With
faire = .ParentWindow.clipboardData.ClearData("text")
End With
End Sub

**fifi5622** · 13/02/2017, 20h21

voila ou j'en suis .....

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 queryurl()
    URL = "http://www.geny.com/partants-pmu/2015-05-19-longchamp-pmu-prix-des-gobelins_c714591"
 
 
  Set IE = CreateObject("InternetExplorer.Application")
IE.Visible = False
 
IE.navigate URL
   Do Until IE.readyState = READYSTATE_COMPLETE
      DoEvents
Loop
 
 
    Set doc = IE.document
    r = doc.body.innerHTML ' code source
    S = doc.body.innerText ' text
 
    MsgBox r  ' c'est la dedans que je vais chercher les getelements table
   ' une recherche sur l'importation des tables va etre necessaire
 
    MsgBox S ' c'est  ok
 
 
End Sub

**fifi5622** · 14/02/2017, 19h42

bon que dire .....

je me suis rendu compte que pilote Ie comme j'ai voulu le faire n'est pas la plus rapide des solutions

mais j'ai appris plein de petites choses sur vba ( sauf vu que je pratique pas bcp je vais sans doute en oublier a force )

alors que je m’étais ENFIN décidé a utiliser une bibliothèque de type ( MSXML2.XMLH ) ce qui en terme de vitesse d’exécution n'a rien avoir mais alors rien ! ( c' étais devant mon nez en plus dans les nombreux code de Marc et de Patrick et d'autres pro du forum )

"il n’est pire aveugle que celui qui ne veut pas voir"

donc au détours d'une multiple recherche et lecture ( j'ai trouvé la ruche de Marc ( mais bon ce n'es pas pour moi ou après 10 ans de vba ) et un gros vieux bourdon mal en point fera bien l'affaire

comprend qui pourra

non j'ai trouve une petite pépite de " PatrickT." merci chef et respect

https://www.developpez.net/forums/d1...ce-d-page-net/

donc bah voila ... ça répond parfaitement a mes besoins

cela semble a ma porté ( sisi ) c'est pas tjs le cas et j'aime bien comprendre au moins un minimum ce que j’insère dans mon fichier !
donc je pense que je vais me débrouiller avec ca peut etre a bientot

**Marc-L** · 15/02/2017, 11h25

Salut !

Désolé, je n'ai pas trop le temps en ce moment …

Effectivement, par ordre de préférence privilégier

• une requête (WinHttp.WinHttpRequest.5.1, Msxml2.XMLHTTP, …)

• une QueryTable

• en derniers recours le pilotage d'IE …

Et l'ordre va fluctuer selon les contraintes !

Quant à l'objet QueryTable, il faut d'abord vérifier manuellement via Nouvelle requête sur le Web
(ou menu Données, A partir du Web) si la page est gérable via cet objet et si c'est le cas,
en activant au préalable l'Enregistreur de macro, une base de code est livrée sur un plateau !
Très utile en prototypage ou quand le temps est compté …
L'astuce est de ne pas forcément enregistrer la QueryTable dans la feuille, un petit Delete et le tour est joué.

**fifi5622** · 15/02/2017, 22h20

salut marc

c'est gentil d'etre venu dire bonjour

t’inquiète je progresse seul garce a vos nombreuses contribution des fois , je m’égare mais je fini tjs pas retrouve mon chemin j'avance petit a petit

<<et l'ordre va fluctuer selon les contraintes >>

ah oui , rhooooo

, rien n'est donc acquis pfffff ....

dans mon cas Timer sera mon juge

avec la procédure de patrick et quelques lignes de code j'extrait les bouts de texte qui m' interresse ( hors table pour le moment )

Code :

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

1
2
3
4
5
 
infos =split( text, "Depart") (1) 
infos =split( infos, "N°) (0) 
infos = Split(infos, vbCrLf) 
Cells(1, 2).Resize(1, UBound(infos) + 1).Value = infos

oui oui ca doit pas etre un " joli" code mais bon ....

ca fonctionne mais j'en arrive a ma me dire pourquoi faire un ubound ( qui va me ralentir ) alors que mon but est juste de vérifier si dans " infos " il y a un ou plusieurs mots clés ( si oui je le récupère le caractère de droite sinon je passe )

sachant que ma macro final (dure environ 40 min d’exécution timer qui le dit )

y a de la marge de progrès c'est moi qui vous le dit ( car les 3/4 de mes modules actuels sont des querytables ) au moins 10 modules ....

**Marc-L** · 16/02/2017, 12h22

UBound est rapide, aucun souci !

Si les données à extraire sont directement dans le code HTML initial de la page Web,
tu peux déjà remplacer l'objet QueryTable par une requête combinée

• soit aux fonctions internes du VBA traitant le texte comme Split

• soit à l'objet htmlfile auquel on peut appliquer les mêmes fonctions décrites dans le tutoriel sur IE
comme par exemple getElementsByTagName ou encore le presse-papier pour copier/coller les données …

Et puis déjà avec la pépite d' "El Pepito" Patrick ! …

Sur un autre forum un traitement de plusieurs dizaines de minutes d'une série de QueryTable a été réduite à
moins de 5 minutes en les remplaçant par des requêtes puis à moins de trente secondes via des abeilles …

**fifi5622** · 18/02/2017, 17h01

https://www.developpez.net/forums/d1...ce-d-page-net/

je ne pensais pas bloquer sur cette partie mais il semble qu'il ait un " loup" avec le code de PatrickToulon

je n'arrive pas a extraire les tables du post avec le code fourni

avant de polluer son beau post je voulais un autre avis

j'ai ce message
erreur compilation fonction ou variable attendu

et on stop sur Table

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
'*********************************************************
'constantes pour les arguments de recherches             *
'                                                        *
Public Const classe = "class="""    '                    *
Public Const ID = "id="""    '                           *
Public Const TR = "<tr>"    '                            *
Public Const TD = "<td>"    '                            *"
Public Const TAble = "<table"    '                      *    '    y a pas un souci la ???? "<table>"    ????? 
'                                                        *
' Vous pouvez ajouter des constante pour les Balises ICI *
' ********************************************************
 Public Function GetCodeSource(sURL, Optional au_format_text As Boolean = "false")
 
    Dim Lapage_en_HTML As Object
    Set Lapage_en_HTML = CreateObject("Microsoft.XMLHTTP")    'instancie l'object
    Lapage_en_HTML.Open "GET", sURL, False   'ouvre l'url dans l'object
    Lapage_en_HTML.send ' envoie la requette
    'selon si la variable "au_format_text" est a true ou falsele texte de sortie sera en html ou texte
    GetCodeSource = IIf(au_format_text, Html_to_text(Lapage_en_HTML.responseText), Lapage_en_HTML.responseText)
End Function
Public Function Html_to_text(codesource)
    'on créé un objet html
    With CreateObject("htmlfile")
        'on y ecrit le codesource complet
        .Write codesource
        'Ici on garde que le texte au format texte( sans les balises)
        Html_to_text = .body.innerText
    End With
End Function
 
Public Function Html_to_outerhtml(codesource)
'on créé un objet html
    With CreateObject("htmlfile")
        'on y ecrit le codesource complet
        .Write codesource
        'Ici on garde que le texte au format outerhtml qui garde en memoire la mise en forme(pratique pour les tables)
        Html_to_outerhtml = .body.outerHTML 'la fonction devient l'element mis en forme
    End With
End Function
 
 Public Function GetElementBY(lien As Variant, Optional balise As String = "", Optional letype As String = "", Optional nom As String = "") As Variant
    Dim code
        code = GetCodeSource(lien) 'recuperation du codesource complet de la page avec l'apel a la fonction getcodesource
    GetElementBY = Split(code, balise & letype & nom) 'decoupage du codesource par les arguments balise et type et nom du type
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
Sub test_de_recuptable()
    Columns("A:F") = ""
    [A2].Select
    Dim l_URL As String, elements, mydata, fich, pag, code 'les variables utiles
    l_URL = "http://www.nasdaq.com/symbol/f/historical" 'declaration de l'url
   [A1] = l_URL
     element = GetElementBY(l_URL, TAble)(3) 'recuperation de l'element
        Set mydata = New DataObject 'instentiation du nouvel object
       code = TAble & Html_to_outerhtml(Split(element, "</table>")(0)) & "</table>" 'reconstitution du code de l'élément
       mydata.SetText code 'inscription du codesource de l'element reconstitué dans l'object
    mydata.PutInClipboard 'mise en pressepapier
    Sheets(3).Paste 'collage du tableau final dans le sheets
End Sub

et pour le code suivant j'ai access refusé ? ( mais c'est un autre souci je pense )

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
Sub test_recup_last_question_vba_sur_DVP()
        [A2].Select
    Dim l_URL As String, elements, mydata, fich, pag
    l_URL = "http://www.developpez.net/forums/f664/logiciels/microsoft-office/excel/macros-vba-excel/"
    elements = GetElementBY(l_URL, "<h3 ", classe, "threadtitle")
     Set mydata = New DataObject
    mydata.SetText Html_to_outerhtml(elements(2))
    mydata.PutInClipboard
    'le code du tableau est copié dans le presse-papiers
    Set fich = ThisWorkbook
    Set pag = fich.Sheets("temp3")
    pag.Paste
End Sub

**fifi5622** · 19/02/2017, 19h22

bon je viens de tester dans une fichier vide et cela fonctionne

il y a donc un souci ailleurs ....

il semble que le code n’apprécie pas que j'appelle un de mes modules " TAbles " ,

**fifi5622** · 28/02/2017, 09h45

bonjour a tous

me voici dans 10 ans plus tard

bon j'ai fini d' adapter la Procédure de PatrickToulon a un de mes modules le plus gourmand (moyenne de 150 pages a ouvrir

)
( j'en ai profiter pour apprendre encore 2 ou 3 truc )

pour rappel : donc je passe par une procédure PatrickToulon que je maîtrise pas ( Microsoft.XMLHTTP ) a la place d'un querytable

et bien que la Procédure soit plus rapide sur 1 course ( dans les mêmes conditions 1min 30 avec la procédure et 2.30 min avec le querytable )
( pour info , il y a environ 40 secondes incompressible ( autres macro)

il y a donc une nette amélioration sauf que voila lorsque j'ai fait des essais a plus grand ampleurs ( plusieurs courses a suivre )

ce ne fut pas une réussite

soit j'etais aussi long que le querytable soit excel " buggais " (plus de réponse ,memoire vive demande & cpu soliicte a fond par excel 1.3 mo de memoire vive en pointe

)

je ne sais pas d'ou étais le souci peut être du l'ouverture de la procédure 'avec "get " et saturation du cache ? ou alors j'ai remarquer que j'importais également des images cachées ( pas au premier plan mais bien presente et a il devait y en avoir bcp !!! )

donc je suis revenu a du plus basique tout effacer l'import et on recommence >> MSXML2 .XMLHTTP un n essai avec ca , c'est rapide c'est bon et hop me retouve a
encore piquer un code a Patrick ( ca sert a quoi que Patrick il se décarcasse sinon

)

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
Sub test22()
    Columns("A:l").Clear
    Dim ReQ As Object, UrL As String
    UrL = "http://www.geny.com/partants-pmu/2015-05-19-longchamp-pmu-prix-des-gobelins_c714591"
    Set ReQ = CreateObject("microsoft.xmlhttp")
    ReQ.Open "POST", UrL, False
    ReQ.setRequestHeader "Accept", "text/html, application/xhtml+xml, */*"
    ReQ.setRequestHeader "Accept-Language", "fr-FR"
    ReQ.setRequestHeader "User-Agent", "Mozilla/5.0 (compatible; MSIE 10.0; Windows NT 6.1; WOW64; Trident/6.0)"
    ReQ.setRequestHeader "Accept-Encoding", "gzip, deflate"
    ReQ.setRequestHeader "Host", "www.geny.com"
    ReQ.setRequestHeader "DNT", 1
    ReQ.setRequestHeader "Connection", "Keep - Alive"
    ReQ.setRequestHeader "Cookie", " JSESSIONID=3E554B80B1ABBC36A2C53EC91C219C77.raoul_1;"
    ReQ.send
 
   txt = ReQ.responseText '  ajout pour avoir le code source  en txt pour extraire hors table ... 
 
 
    Set fauxdoc = CreateObject("htmlfile")
    With fauxdoc
        .body.innerHTML = ReQ.responseText
         Set grouptable = .getelementsbytagname("TABLE")
         For i = 0 To grouptable.Length - 1
           If grouptable(i).ParentNode.ID = "dt_partants" Then Set matable = grouptable(i)
        Next
 
        faire = .parentWindow.clipboardData.setData("text", matable.outerhtml)
        With Sheets(1)
            Set cel = .Cells(Rows.Count, 1).End(xlUp).Offset(2, 0)
            cel.Select
            .Paste:
        End With
        faire = .parentWindow.clipboardData.clearData("text")
    End With
End Sub

j'utilise ce code il fonctionne bien , j'ai ajouter cela "txt = ReQ.responseText " pour pouvoir extraire d'autres éléments de la page
( texte entre autres )
il fait le travail complet ( en 20 min au lieu de 40 min ) les 10 premières minutes sont dues a d'autres macro
et il me reste a optimiser mon code (avec des cells , des option explicit en debut de code ( variant c'est pratique mais gourmand !!! ) et 2 , 3 choses encore ... )

par contre 2 choses me chagrine

>>>> 1) j'importe encore des images !! elle ne sont pas tjs visible mais sont bien la comment les enlever avant importation ?
Picture.Delete ??

>>>> 2 ) je ne suis pas un grand fan de cette methode ( faire = .parentWindow.clipboardData.setData("text", matable.outerhtml)

d’ailleurs je la comprend pas trop ( va dans le presse papier windows et colle les donnees texte ? ( ma table outre tombe ?

)

je n'aime pas passez par le pressepapier windows y a til un autre moyen de coller la table sur ma feuilles ?

QueryTables VS IE = CreateObject("internetexplorer.application")

Macros et VBA Excel

Discussions similaires

Partager

Partager