recup donnée internet transfert de question de THAHARDY

**patricktoulon** · 05/06/2015, 23h18

Bonjour thahardy
je post la réponse a ta demande sur un nouveau post
et a l'avenir évite de polluer le fil d'une autre discussion
merci de ta compréhension

voila ton code
j'ai modifié la wait IE ,on oublie souvant le "IE.busy"
en effet parfois le readystate nous donne la main mais la page travaille encore

j'ai modifié l'utilisation de l'object IE maintenant en late binding afin d'avoir un fichier transportable et utilisable sur tout ordi avec exel 2003 minimum sans avoir de références a activer
j'ai tronqué aussi l'utilisation de variable object (famille "IE") pas necessaire dans ce cas présent

j'ai mis quelques commentaire qui t'aideront a comprendre le 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
Option Explicit
Sub WaitIE(IE As Object)
'On boucle tant que la page n'est pas totalement chargée
    Do: DoEvents: Loop While IE.readystate <> 4 Or IE.busy
End Sub
Sub RechercheVBAExcel()
'Déclaration des variables
    Dim IE As Object, matable As Object, i As Long, lignes As Object, valeur As String
    Set IE = CreateObject("internetexplorer.application")
    IE.navigate "www.google.com/finance"    'Chargement d'une page Web Google
    IE.Visible = True
    'Affichage de la fenêtre IE
    WaitIE IE    'On attend le chargement complet de la page
    With IE.document
        .all("q").Value = "VSAR"    'on inscrit le texte dans le textbox "q"
        .all("gbqfb").Click    'On click sur le  bouton
        WaitIE IE
        Set matable = .getelementsbyclassname("snap-data")(0)    'on recupere la table concernée par sa classe ,c'est la 1 ere donc l'index 0  !!!
        Set lignes = matable.getelementsbytagname("tr")    'on prent les lignes complete du tableau
        For i = 0 To lignes.Length - 1
            'on test si la premiere cellule de chaque ligne est ecrit "Mkt cap" si oui la valeur est la 2 eme cellule  de la meme ligne
            If RTrim(lignes(i).Children(0).innertext) = "Mkt cap" Then valeur = lignes(i).Children(1).innertext
        Next
    End With
    IE.Quit
    Set IE = Nothing 'On libère la variable "IE"
 
    MsgBox valeur
    End Sub

**patricktoulon** · 05/06/2015, 23h47

quand on utilise l'espion f12 de IE on remarque quelques petits détails for intéressants

il y a moyen de simplifier ta procédure
en effet plutôt que d'aller sur la page d'accueil "finance "
on peut mettre les argument directement dans l'url avec Google c'est souvent comme ca
donc on peut utiliser l'url comme ceci:

http://www.google.com/finance?q=VSAR

ainsi on a plus a marquer et cliquer puisque l'on tombe sur la page de "VSAR" directement
ensuite dans le précèdent exemple je prenais la table puis disséquais les lignes
maintenant on prend toutes les lignes de toutes les table de la page web
et on teste son intitulé
et le tour est joué

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
Sub test()
    Dim IE As Object, matable As Object, i As Long, lignes As Object, valeur As String
    Set IE = CreateObject("internetexplorer.application")
    IE.navigate "http://www.google.com/finance?q=VSAR"   'Chargement d'une page Web Google"
    IE.Visible = True    'Affichage de la fenêtre IE
    WaitIE IE    'On attend le chargement complet de la page
 
    With IE.document
         Set lignes = .getelementsbytagname("tr")    'on prend toutes les lignes de toutes les tables de la page web
        For i = 0 To lignes.Length - 1
            'on test si la premiere cellule de chaque ligne est ecrit "Mkt cap" si oui la valeur est la 2 eme cellule  de la meme ligne
            If RTrim(lignes(i).Children(0).innertext) = "Mkt cap" Then valeur = lignes(i).Children(1).innertext
        Next
    End With
    IE.Quit
    Set IE = Nothing    'On libère la variable "IE"
    MsgBox valeur
End Sub
Sub WaitIE(IE As Object)
'On boucle tant que la page n'est pas totalement chargée
    Do: DoEvents: Loop While IE.readystate <> 4 Or IE.busy
End Sub

beaucoup plus simple non???

**ThaHardy** · 08/06/2015, 12h09

Tout d'abord un GRAND merci pour ton aide patricktoulon!
Et permet moi de m'excuser pour la polution d'autre discussions mais je ne savais pas trop ou poster ma question..

Ensuite effectivement dans l'idée la deuxieme solution semble plus simple cependant la recherche "VSAR" que j'avais mis au moment de commencer mon code n'était que pour tester que ce dernier fonctionnait correctement.
Je n'aurais qu'une question; comment puis-je faire pour qu'au lieu d'avoir VSAR comme recherche comment faire pour que la recherche soit faite avec la valeur contenu dans un champs (ici le nom de sociétés enregistré dans la base) et qu'a chaque fois on extrait la valeur Market Cap de la page IE pour la rentrer/modifier dans un autre champs de la table ou on est aller chercher le texte de la recherche ?
Je ne sais pas si j'ai ete clair mais globalement cela serait pour mettre a jour la Market cap de chaque companie enregistré dans la base. L'idée serait a termes que les market Cap soient mis a jour a chaque ouverture de la base.
Etant tout a fait nouveau dans le domaine soyez un peu indulgent si mes questions vous semble simplissime..

Cordialement
TH

Re-bonjour,
Je répete que je suis tout a fait nouveau en VBA et Access, Mais quand je run la Macro voila ce que j'obtiens ..

Cordialement

**patricktoulon** · 08/06/2015, 18h11

Bonjour ta capture d'écran montre que tu utilise la méthode 1
perso je préfère la 2 elle est plus généraliste

et pour ton problème de variable "vsar" et autre
voici un exemple qui boucle sur une plage "a1:a10" et envoie dans l"url l'argument
en retour la cellule juste a coté et a droite reçoit la valeur

mais cependant si tu dois en avoir beaucoup je te suggère d'utiliser une requête (beaucoup plus rapide )
voici un exemple avec 10 valeur a trouver a toi de mettre ces valeur en colonne A

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
Sub test()
  Set plage = Range("A1:A10")
 
    For Each cel In plage.Cells
    Dim IE As Object, matable As Object, i As Long, lignes As Object, valeur As String
    Set IE = CreateObject("internetexplorer.application")
    IE.navigate "http://www.google.com/finance?q=" & cel.Value  'Chargement d'une page Web Google"
    IE.Visible = True    'Affichage de la fenêtre IE
    WaitIE IE    'On attend le chargement complet de la page
 
    With IE.document
         Set lignes = .getelementsbytagname("tr")    'on prend toutes les lignes de toutes les tables de la page web
        For i = 0 To lignes.Length - 1
            'on test si la premiere cellule de chaque ligne est ecrit "Mkt cap" si oui la valeur est la 2 eme cellule  de la meme ligne
            If RTrim(lignes(i).Children(0).innertext) = "Mkt cap" Then valeur = lignes(i).Children(1).innertext
        Next
    End With
    IE.Quit
    Set IE = Nothing    'On libère la variable "IE"
   cel.Offset(0, 1) = valeur
next
End Sub

sinon comme ca vite fait un exemple avec une requête admire la rapidité

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
Sub par_requete()
    Dim REQ, URL,i,a
    URL = "http://www.google.com/finance?q=VSAR"
    Set REQ = CreateObject("microsoft.xmlhttp")
    REQ.Open "POST", URL, False
    REQ.setRequestHeader "User-Agent", "Mozilla/5.0 (compatible; MSIE 10.0; Windows NT 6.1; WOW64; Trident/6.0)"
    REQ.send
       With CreateObject("htmlfile")
        .write REQ.responsetext
        Set meslignes = .getelementsbytagname("TR")
        For i = 0 To meslignes.Length - 1
            For a = 0 To meslignes(i).Children.Length - 1
                 If meslignes(i).Children(a).innertext = "Mkt cap " Then valeur = meslignes(i).Children(a + 1).innertext
            Next
        Next
    End With
    MsgBox valeur
set REQ=nothing
End Sub

**ThaHardy** · 09/06/2015, 10h31

Bonjour,
Merci c'est sympa je vais essayer ca tout de suite.
Juste pour etre sur; je peux utiliser la méthode de plage sur ACCESS 2010 également?
Si oui;
- Comment sélectionner la colone dans la table ou se trouve la variable ?
- Comment demander a la Macro de placer la valeur trouvée dans une autre cellule de cette meme table mais sur la meme ligne ou le code a pris la variable bien évidemment ?

Car j'ai l'impression que ton code ne marche pas sur ACCESS ou bien j'ai commis une erreur quelque part, mais dans ce cas je ne sais pas ou..

En tout cas merci de ton aide précieuse !

Cordialement

TH

**patricktoulon** · 09/06/2015, 11h04

salut thahardy

non pas sur accès a vrai dire tu est sur le forum "vba Excel" ici

mais mis a part la sélection de cellule pour le reste ca ne doit pas trop changer
je ne m'y suis jamais intéressé je vais regarder un peu sur acces

**ThaHardy** · 09/06/2015, 11h17

ah okay, je sais pas trop comment j'ai atterit sur le VBA excel, excuse moi si je pollue du coup

Oui je pense que cela ne differe pas trop mais je t'avoue n'avoir aucune idée de comment faire ma selection et de comment renvoyer la valeur dans la cellule voulu..

Merci pour l'interet que tu portes a mon probleme !

Bien Cordialement

TH

**mercatog** · 10/06/2015, 12h40

J'implémente la solution de PatrickToulon dans access (Forum différent mais pour dépanner)

Si la table nommée maTable contient entre autre les champs MonTitre (le titre à chercher), MaValeur (la valeur à récupérer), MaDate (la date de mise à jour)

Dans un formulaire avec un bouton nommé btnremplir, mettre 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
Option Compare Database
Option Explicit
 
Private Sub BtnRemplir_Click()
Dim SetA As Object
Dim LaValeur As String
 
Set SetA = CurrentDb.OpenRecordset("MaTable", dbOpenTable)
With SetA
    Do Until .EOF
        LaValeur = MktCap(!MonTitre)
        .Edit
        !MaValeur = LaValeur
        !MaDate = Now()
        .Update
        .MoveNext
    Loop
    .Close
End With
Set SetA = Nothing
MsgBox "Terminé"
End Sub
 
Private Function MktCap(ByVal Titre As String) As String
Dim REQ As Object, HTML As Object, MesLignes As Object
Dim URL As String, Txt As String, Valeur As String
Dim i As Long, a As Long
Dim Fin As Boolean
 
URL = "http://www.google.com/finance?q=" & Titre
Set REQ = CreateObject("microsoft.xmlhttp")
With REQ
    .Open "POST", URL, False
    .SetRequestHeader "User-Agent", "Mozilla/5.0 (compatible; MSIE 10.0; Windows NT 6.1; WOW64; Trident/6.0)"
    .Send
    Txt = .ResponseText
End With
Set REQ = Nothing
 
Set HTML = CreateObject("htmlfile")
With HTML
    .Write Txt
    Set MesLignes = .GetElementsByTagName("TR")
    For i = 0 To MesLignes.Length - 1
        For a = 0 To MesLignes(i).Children.Length - 1
            If MesLignes(i).Children(a).InnerText = "Mkt cap " Then
                MktCap = MesLignes(i).Children(a + 1).InnerText
                Fin = True
                Exit For
            End If
        Next a
        If Fin Then Exit For
    Next i
    Set MesLignes = Nothing
    .Close
End With
Set HTML = Nothing
End Function

**patricktoulon** · 10/06/2015, 23h01

Bonjour Mercatog

tu peux dépanner tant que tu veux au contraire j'apprend moi aussi je ne l'ai jamais fait avec accès

et c'est en regardant ton code que je me suis rendu compte que je faisait des détours pour rien avec ma double boucle imbriquée
en fait cela suffit puisque on se repère au 1 er enfant de la ligne dans la table

Code :

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

1
2
3
4
5
6
7
With CreateObject("htmlfile")
        .write REQ.responsetext
        Set meslignes = .getelementsbytagname("TR")
        For i = 0 To meslignes.Length - 1
                     If meslignes(i).Children(0).innertext = "Mkt cap " Then valeur = meslignes(i).Children(1).innertext
        Next
End With

**ThaHardy** · 11/06/2015, 11h52

Bonjour,
Mercatog tu es tout simplement génial !!! Une reponse claire et consise dont j'ai pu appliquer le contenu en 5 min avec un résultat qui marche a merveille !! MERCI BEAUCOUP

Merci également a toi patricktoulon pour l'interet que tu as porté a mon probleme !

Du coup j'aurai aimer savoir si tu pouvais détailler le code pour bien comprendre chaque étape du code pour que je puisse le réutiliser a l'occcasion ?
Merci d'avance

Trés cordialement !

TH

**ThaHardy** · 12/06/2015, 17h15

Bonjour,
mercatog je voulais te remercier une fois deplus pour ton aide.
Si je reposte aujourd'hui c'est parceque j'ai eu besoin a nouveau d'utiliser "le meme code" pour faire la meme mise a jour sur google finance encore une fois, mais cette fois ci c'est pour avoir la valeur de différentes Devises/Monnaies en USDollar. ( pour le faire j'ai créer une table Currency comportant un champs Currency un champs CurrencyToDollar et un champs CurrencyRateDate ainsi qu'un ID)
Du coup j'ai essayé de comprendre et d'adapter le code; voila ce que j'ai:

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
Option Compare Database
Option Explicit
 
Private Sub BtnCurrency_Click()
Dim SetA As Object
Dim LaValeur As String
 
Set SetA = CurrentDb.OpenRecordset("TBLCurrency", dbOpenTable)
With SetA
    Do Until .EOF
        LaValeur = Rate(!Currency)
        .Edit
        ![CurrencyToDollar] = LaValeur
        ![CurrencyRateDate] = Now()
        .Update
        .MoveNext
    Loop
    .Close
End With
Set SetA = Nothing
MsgBox "Currency Rates have been updated with success"
End Sub
 
Private Function Rate(ByVal Currency_Rate As String) As String
Dim REQ As Object, HTML As Object, MesLignes As Object
Dim URL As String, Txt As String, Valeur As String
Dim i As Long, a As Long
Dim Fin As Boolean
 
URL = "http://www.google.com/finance?q=" & Currency_Rate
Set REQ = CreateObject("microsoft.xmlhttp")
With REQ
    .Open "POST", URL, False
    .setRequestHeader "User-Agent", "Mozilla/5.0 (compatible; MSIE 10.0; Windows NT 6.1; WOW64; Trident/6.0)"
    .send
    Txt = .responseText
End With
Set REQ = Nothing
 
Set HTML = CreateObject("htmlfile")
With HTML
    .Write Txt
    Set MesLignes = .getElementsByTagName("class")
    For i = 0 To MesLignes.length - 1
        For a = 0 To MesLignes(i).Children.length - 1
            If MesLignes(i).Children(a).innerText = "bld" Then
                Rate = MesLignes(i).Children(a + 1).innerText
                Fin = True
                Exit For
            End If
        Next a
        If Fin Then Exit For
    Next i
    Set MesLignes = Nothing
    .Close
End With
Set HTML = Nothing
End Function

Cependant cela ne fonctionne pas (Si j'ai bien compris le code Je pense que c'est parceque je ne trouve pas le texte qui se trouve avant le sous menu ou se trouve la valeur) je n'ai que la date qui rentre dans la table ...

Voila donc si vous avez une idée de mon probleme ca serait génial !!

Merci d'avance pour votre aide.

Cordialement

TH

**patricktoulon** · 12/06/2015, 21h09

bonjour
pour la requête a mon avis ca doit venir de la

Code :

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

Set MesLignes = .getElementsByTagName("class")

c'est bien la premiere fois que je verrais un élément html avoir

class="class"

entre nous
je pense que tu fait l'amalgame entre la propriété "classname" et et la fonction elle même
quand on se sert de cette fonction c'est le nom de la class pas la propriété "class"
Set MesLignes = .getElementsByTagName("class")[/CODE]
a mon avis c'est bien de la que ca vient
car ca violerait toute les règles du développeur "utiliser une expression comme un string""
et cela m'étonnerait beaucoup !!
Au plaisir

**mercatog** · 13/06/2015, 01h57

Il suffit de chercher l'info désirée dans la variable Txt

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
Function Rate(ByVal Currency_Rate As String) As Variant 'Ou bien As Single
Dim URL As String, Txt As String, TxtRate As String
Dim REQ As Object
Dim N As Long
 
 
URL = "http://www.google.com/finance?q=" & Currency_Rate
Set REQ = CreateObject("microsoft.xmlhttp")
With REQ
    .Open "POST", URL, False
    .setRequestHeader "User-Agent", "Mozilla/5.0 (compatible; MSIE 10.0; Windows NT 6.1; WOW64; Trident/6.0)"
    .send
    Txt = .ResponseText
End With
Set REQ = Nothing
 
N = InStr(Txt, "1 " & Currency_Rate)
If N > 0 Then
    TxtRate = Mid(Txt, N)
    TxtRate = Left(TxtRate, InStr(TxtRate, "USD") - 2)
    TxtRate = Mid(TxtRate, InStr(TxtRate, ">") + 1)
    Rate = TxtRate
End If
End Function

PS. On pourrait aussi récupérer la date de cotation (sous forme de texte de type Jun 12, 11:34PM)

**ThaHardy** · 15/06/2015, 10h30

Un grand merci Mercatog,
Comme la derniere fois cela marche parfaitement !

Du coup comment ferais tu pour récupérer la date de cotation? Car par soucis de précision effectivement cela serait mieux (merci de m'y avoir fait penser)

Cordialement

TH

**Marc-L** · 15/06/2015, 10h46

Bonjour,

en utilisant l'outil d'inspection d'un navigateur, la solution évidente est de récupérer le texte de l'ID "price-panel"
contenant la cotation en première ligne et la date en seconde (un p'tit Split) via la méthode du post #5 de Patrick …

Sinon directement dans le code, le B-A-BA est au moins d'y regarder ce que définit la donnée à extraire !
Et ici c'est simple : <span class="nwp"> (là encore avec un Split) …

_____________________________________________________________________________________________________
Je suis Charlie - Je suis Bardo

**mercatog** · 15/06/2015, 11h50

ThaHardy, j'espère que tu vas t'approprier la méthode pour t'envoler de tes propres ailes.

Regarde la recommandation de Marc-L

Sinon, pour la dernière fois sur le même point (j'ajoute du sel avec un type personnalisé)

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
Option Compare Database
Option Explicit
 
Private Type Cotation
    Taux As Single
    Dte As String
End Type
 
Private Sub BtnCurrency_Click()
Dim LaValeur As Cotation
Dim SetA As Object
 
Set SetA = CurrentDb.OpenRecordset("TBLCurrency", dbOpenTable)
With SetA
    Do Until .EOF
        LaValeur = Rate(!Currency)
        .Edit
        With LaValeur
            ![CurrencyToDollar] = .Taux
            ![CurrencyRateDate] = .Dte
        End With
        .Update
        .MoveNext
    Loop
    .Close
End With
Set SetA = Nothing
MsgBox "Currency Rates have been updated with success"
End Sub
 
Function Rate(ByVal Currency_Rate As String) As Cotation
Dim URL As String, Txt As String, TxtRate As String, TxtDate As String
Dim REQ As Object
Dim N As Long
 
 
URL = "http://www.google.com/finance?q=" & Currency_Rate
Set REQ = CreateObject("microsoft.xmlhttp")
With REQ
    .Open "POST", URL, False
    .setRequestHeader "User-Agent", "Mozilla/5.0 (compatible; MSIE 10.0; Windows NT 6.1; WOW64; Trident/6.0)"
    .send
    Txt = .ResponseText
End With
Set REQ = Nothing
 
N = InStr(Txt, "1 " & Currency_Rate)
If N > 0 Then
    TxtRate = Mid(Txt, N)
    TxtRate = Left(TxtRate, InStr(TxtRate, "USD") - 2)
    TxtRate = Mid(TxtRate, InStr(TxtRate, ">") + 1)
 
    TxtDate = Mid(Txt, InStr(Txt, "<div class=time id="))
    TxtDate = Left(TxtDate, InStr(TxtDate, "GMT") - 2)
    TxtDate = Mid(TxtDate, InStr(TxtDate, ">") + 1)
 
    With Rate
        .Taux = TxtRate
        .Dte = TxtDate
    End With
End If
End Function

PS. attention pour la compatibilité des données, la date de cotation est du texte, il faudra en tenir compte dans ta table TBLCurrency.

**ThaHardy** · 15/06/2015, 12h11

Merci a vous c'est bien sympa de votre part,

J'ai essayé de comprendre commment le premier code marchait pour l'appliqué aux Currencies mais je vous avoue que je suis un nouveau né dans le domaine Access et VBA en général étant donné que je viens de commencé donc je vous avoue que de temps a autres j'ai du mal a saisir tout les nuances des codes que vous me donné mais je fais effectivement mon possible pour m'apporprier les codes mais ce n'est pas toujours évident.

En tout cas merci beaucoup pour votre aide cela marche du feu de dieu ! C'est génial merci a tous et bonne continuation... et peut-etre a la prochaine

Amicalement

TH

**Marc-L** · 15/06/2015, 12h51

Bonjour Mercatog !

Dans le code actuel renvoyé par la requête, je ne trouve pas de <div class=time id= ! (test sur VSAR)

Il y a bien un élément Span avec cette classe mais en référence à un évènement futur du 3 Août …