Sub testweb() ' ' testweb Macro 'definition des variables Dim IE As New InternetExplorer Dim IEDoc As HTMLDocument Dim InputGoogleZoneTexte As HTMLInputElement Dim InputGoogleBouton As HTMLInputElement 'Chargement d'une page Web societe.com IE.navigate "www.pagespro.com" 'affichage de la page IE.Visible = True 'On attend le chargement complet de la page WaitIE IE 'On pointe le membre Document Set IEDoc = IE.document 'On pointe notre bouton siren Set InputGoogleBouton = IEDoc.getElementById("siren") 'On simule un clic InputGoogleBouton.Click 'On pointe notre Zone de texte Set InputGoogleZoneTexte = IEDoc.all("siren_exp") 'On définit le texte que l'on souhaite placer à l'intérieur siret InputGoogleZoneTexte.Value = "78002829600017" 'On pointe notre bouton Set InputGoogleBouton = IEDoc.all("bouton_trouver_exp") 'On simule un clic InputGoogleBouton.Click 'On attend la fin de la recherche WaitIE IE
La ligne de commande :
15 waitIE IE fait reference à un autre module?
Sub WaitIE(IE As InternetExplorer) 'Boucle tant que la page n'est pas totalement chargée '**************************************************** Do Until IE.readyState = READYSTATE_COMPLETE DoEvents Loop End Sub
Sub WaitDoc(doc As HTMLDocument) Do While Not doc.readyState = "complete" DoEvents Loop End Sub
par contre si tu peux m'expliquer en deux mots ce que c'est cette histoire d'enfant... :)
<div id="parent"> <ul id="premierfils_de_div"> <li id="petitfils_de_div" class="premierfils_de_ul"> <a id="premierfilsdeli">Texte du lien 1</a> </li> <li id="petitfils_de_div" class="secondfils_de_ul"> <a id="premierfilsdeli">Texte du lien 2</a> </li> </ul> <ul id="secondfilsdediv"> <li id="petitfils_de_div" class="premierfils_de_ul"> <a id="premierfilsdeli">Texte du lien 3</a> <a id="secondfilsdeli">Texte du lien 4</a> <a id="dernierfilsdeli">Texte du lien 5</a> </li> </ul> </div>
Set Fiston = MyLi.FirstChild
est-il possible de rechercher une balise par class
d'après ce que j'ai compris c'est pas possible
For Each aElement In SourceElem If aElement.ClassName = aClassName Then
sur ma page suivante je veux cliquez sur le lien plus dinfo sur l'entreprise
j'ai remarqué que dans le code HTML ci dessous qui correspond à mon objet de clique il y a le terme "plus d'infos sur l'entreprise" en noir,
je veux donc faire une recherche sur ce terme pour définir ma variable VBA
<a class="icon_infos" id="icon_infos_6480431">Plus d'infos sur l'entreprise</a>
Dim CollLiens As IHTMLElementCollection Dim Liens As HTMLGenericElement Set CollLiens = IEDoc.getElementsByTagName("a") For Each Liens In CollLiens Debug.Print Liens.innerText & " -- " & Liens.innerHtml Next
j'arrive à ouvrir une page web
mais je n'arrive pas cliquez sur un bouton précis
Dim InputGoogleBouton As HTMLInputElement 'On pointe notre bouton siren Set InputGoogleBouton = IEDoc.getElementById("siren")
<li id="siren"> <a>monlien</a </li>
Dim IE As New InternetExplorer Dim IEDoc As HTMLDocument Dim MyLi As HTMLLIElement Dim Fiston As HTMLAnchorElement Dim Info As HTMLAnchorElement Dim Numtel As HTMLLIElement Dim LeTexteExtrait As String 'Chargement d'une page Web societe.com IE.navigate "www.pagespro.com" 'affichage de la page IE.Visible = True 'On attend le chargement complet de la page WaitIE IE 'On pointe le membre Document Set IEDoc = IE.document 'On pointe notre bouton siren Set MyLi = IEDoc.getElementById("siren") 'On simule un clic Set Fiston = MyLi.FirstChild Fiston.Click 'On pointe notre Zone de texte Set InputGoogleZoneTexte = IEDoc.all("siren_exp") 'On définit le texte que l'on souhaite placer à l'intérieur siret InputGoogleZoneTexte.Value = "78002829600017" 'On pointe notre bouton Set InputGoogleBouton = IEDoc.all("bouton_trouver_exp") 'On simule un clic InputGoogleBouton.Click 'On attend la fin de la recherche WaitIE IE 'On pointe notre bouton plus d'info sur l'entreprise Set IEDoc = IE.document Set MyLi = IEDoc.getElementById("cleft") Set Info = MyLi.Children(6).Children(0).Children(1).Children(0).Children(3).Children(0).Children(1).Children(0) Info.Click 'on charge la page actuelle Set IEDoc = IE.document Set Numtel = IEDoc.getElementById("non_free_num_ui").Children(1) LeTexteExtrait = Numtel.innerText
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre questionSub testweb()
Dim IE As New InternetExplorer
Dim IEDoc As HTMLDocument
Dim MyLi As HTMLLIElement
Dim Fiston As HTMLAnchorElement
Dim Info As HTMLAnchorElement
Dim Numtel As HTMLLIElement
Dim Numteltxt As String
Dim CA As HTMLGenericElement
Dim CAtext As String
Dim EF As HTMLLIElement
Dim EFtext As String
Dim EBE As HTMLLIElement
Dim EBEtext As String
Dim htmlTabElement() As IHTMLElement
Dim GenericElem As HTMLGenericElement
'Chargement d'une page Web societe.com
IE.navigate "www.pagespro.com"
'affichage de la page
IE.Visible = True
'On attend le chargement complet de la page
WaitIE IE
'On pointe le membre Document
Set IEDoc = IE.document
'On pointe notre bouton siren
Set MyLi = IEDoc.getElementById("siren")
'On simule un clic
Set Fiston = MyLi.FirstChild
Fiston.Click
'On pointe notre Zone de texte
Set InputGoogleZoneTexte = IEDoc.all("siren_exp")
'On définit le texte que l'on souhaite placer à l'intérieur siret
InputGoogleZoneTexte.Value = "78002829600017"
'On pointe notre bouton
Set InputGoogleBouton = IEDoc.all("bouton_trouver_exp")
'On simule un clic
InputGoogleBouton.Click
'On attend la fin de la recherche
WaitIE IE
'On pointe notre bouton plus d'info sur l'entreprise
Set IEDoc = IE.document
Set MyLi = IEDoc.getElementById("cleft")
Set Info = MyLi.Children(6).Children(0).Children(1).Children(0).Children(3).Children(0).Children(1).Children(0)
Info.Click
'on charge la page actuelle
Set IEDoc = IE.document
'on recupère les données
Set Numtel = IEDoc.getElementById("non_free_num_ui").Children(1)
Numteltxt = Numtel.innerText
'On recherche l'élément le plus proche du tableau
Set GenericElem = IEDoc.getElementById("eco_emb_body_main_back")
'On recherche les éléments ayant "index" comme classe
'et qui se trouvent dans les enfants directs de GenericElem
htmlTabElement = getElementsByClassName(GenericElem, "achatRapport", False)
Set CA = IEDoc.getElementById("eco_emb_body_main_back").Children(0).Children(0).Children(1).Children(1).Children(2).Children(1)
CAtext = CA.innerText
Set EF = IEDoc.getElementById("notice_list").Children(0).Children(2).chidren(0).chidren(0).chidren(1)
EFtext = EF.innerText ' pas sur de l'adresse
Set EBE = IEDoc.getElementById("blocBas").Children(1).Children(3).chidren(1)
EBEtext = EBE.innerText
Option Explicit Const TXT_URL As String = "www.pagespro.com" Const ID_LI_SIREN As String = "siren" Const ID_INPUT_SIREN As String = "siren_exp" Const ID_INPUT_BUTTON_TROUVER As String = "bouton_trouver_exp" Const ID_LIEN_INFOS As String = "icon_infos_6480431" Sub testweb() Dim IE As New InternetExplorer Dim IEDoc As HTMLDocument Dim MyLi As HTMLLIElement Dim LienSiren As HTMLAnchorElement Dim InputSiren As HTMLInputElement Dim InputBtnTrouver As HTMLInputButtonElement Dim Info As HTMLAnchorElement Dim htmlTabElement() As IHTMLElement Dim GenericElem As IHTMLElement Dim Elem As IHTMLElement Dim Numtel As HTMLLIElement Dim Numteltxt As String Dim CA As HTMLGenericElement Dim CAtext As String Dim EF As HTMLLIElement Dim EFtext As String Dim EBE As HTMLLIElement Dim EBEtext As String 'Chargement d'une page Web societe.com IE.navigate TXT_URL 'affichage de la page IE.Visible = True 'On attend le chargement complet de la page WaitIE IE 'On pointe le membre Document Set IEDoc = IE.document WaitDoc IEDoc 'On pointe notre bouton siren Set MyLi = IEDoc.getElementById(ID_LI_SIREN) 'On simule un clic Set LienSiren = MyLi.FirstChild LienSiren.Click 'On pointe notre Zone de texte Set InputSiren = IEDoc.getElementById(ID_INPUT_SIREN) 'On définit le texte que l'on souhaite placer à l'intérieur siret InputSiren.Value = "78002829600017" 'On pointe notre bouton Set InputBtnTrouver = IEDoc.getElementById(ID_INPUT_BUTTON_TROUVER) 'On simule un clic InputGoogleBouton.Click 'On attend la fin de la recherche WaitIE IE 'On pointe notre bouton plus d'info sur l'entreprise Set IEDoc = IE.document WaitDoc IEDoc Set Info = IEDoc.getElementById(ID_LIEN_INFOS) Info.Click 'on charge la page actuelle Set IEDoc = IE.document WaitDoc IEDoc '****************************** A PARTIR D'ICI 'on recupère les données Set Numtel = IEDoc.getElementById("non_free_num_ui").Children(1) Numteltxt = Numtel.innerText 'On recherche l'élément le plus proche du tableau Set GenericElem = IEDoc.getElementById("blocBas") 'On recherche les éléments ayant "index" comme classe 'et qui se trouvent dans les enfants directs de GenericElem htmlTabElement = getElementsByClassName(GenericElem, "achatRapport", False) If Not htmlTabElement Is Nothing Then For Each Elem In htmlTabElement MsgBox Elem.innerText Next End If ' Set CA = IEDoc.getElementById("eco_emb_body_main_back").Children(0).Children(0).Children(1).Children(1).Children(2).Children(1) ' CAtext = CA.innerText ' Set EF = IEDoc.getElementById("notice_list").Children(0).Children(2).chidren(0).chidren(0).chidren(1) ' EFtext = EF.innerText ' pas sur de l'adresse ' Set EBE = IEDoc.getElementById("blocBas").Children(1).Children(3).chidren(1) ' EBEtext = EBE.innerText End Sub Sub WaitIE(IE As InternetExplorer) Do Until IE.readyState = READYSTATE_COMPLETE DoEvents Loop End Sub Sub WaitDoc(doc As HTMLDocument) Do While Not doc.readyState = "complete" DoEvents Loop End Sub Function getElementsByClassName(IEParentElement As IHTMLElement, aClassName As String, Optional JustChildren As Boolean = False) As IHTMLElement() 'Retourne un tableau contenant les éléments de la page ayant pour Class aClasseName Dim aElement As IHTMLElement Dim FuncElements() As IHTMLElement Dim SourceElem As IHTMLElementCollection Dim iElem As Integer 'On prend en compte le lieu de recherche If JustChildren Then 'Ici on ne tiendra compte que des enfants directs de IEParentElement Set SourceElem = IEParentElement.Children Else Set SourceElem = IEParentElement.all End If 'On boucle sur tous les éléments contenus dans SourceElem For Each aElement In SourceElem 'On vérifie si l'élément correspond à notre recherche If aElement.ClassName = aClassName Then 'On redimensionne notre tableau 'Cela semble inutile de regarder si FuncElements est un Array... 'Mais sans cette ligne FuncElement n'est jamais reconnu comme tel... iElem = IIf(IsArray(FuncElements), UBound(FuncElements) + 1, -1) ReDim Preserve FuncElements(iElem) 'Et on place l'élément trouvé à l'intérieur Set FuncElements(UBound(FuncElements)) = aElement End If Next 'On place le tableau en retour de notre fonction getElementsByClassName = FuncElements 'On libère l'espace mémoire occupé par notre tableau provisoire Erase FuncElements End Function
<a class="achatRapport" href="/pages_pro/access.jsp?Siren=780028296&Nic=17" abp="57">2 086 K Euros</a>
Set CA = IEDoc.getElementById("eco_emb_body_main_back")
CAtext = CA.innerText
Dim maCollLiens As IHTMLElementCollection Dim Lien As HTMLAnchorElement 'blabla, tout ton code ici 'Liste toutes les balises <a> du document Set maCollLiens = IEDoc.getElementsByTagName("a") 'boucle sur toutes les balises <a> For Each Lien In maCollLiens 'si classname = "achatrapport" If Lien.className = "achatrapport" Then MsgBox "gagné : " & Lien.InnerText Next
Set maCollLiens = IEDoc.getElementsByTagName("div")
'boucle sur toutes les balises <div>
For Each Lien In maCollLiens
'si classname = "head"
If Lien.className = "head" Then MsgBox "gagné : " & Lien.innerText
Next
Set maCollLiens = IEDoc..body.all.tags("a")
Set maCollLiens = IEDoc.body.getElementsByTagName("div")
Option Explicit
Const TXT_URL As String = "www.societe.com"
Const ID_CA As String = "presentationlien"
Const ID_TAB As String = "rensjur"
Const ID_INPUT_SIREN As String = "etablissement"
Const ID_INPUT_SIREN2 As String = "etab"
Const ID_INPUT_BUTTON_TROUVER As String = "buttsearch"
Const ID_LIEN_INFOS As String = "icon_infos_6480431"
Sub Web()
Dim IE As New InternetExplorer
Dim IEDoc As HTMLDocument
Dim MyLi As HTMLInputElement
Dim InputSiren As HTMLInputButtonElement
Dim InputBtnTrouver As HTMLInputButtonElement
Dim Stepsearch As IHTMLElement
Dim NAF As HTMLGenericElement
Dim NAFtext As String
Dim CA As HTMLGenericElement
Dim CAtext As String
Dim EF As HTMLLIElement
Dim EFtext As String
Dim i
For i = 2 To 2310
'Chargement d'une page Web societe.com
IE.navigate TXT_URL
'affichage de la page
IE.Visible = True
'On attend le chargement complet de la page
WaitIE IE
'On pointe le membre Document
Set IEDoc = IE.document
WaitDoc IEDoc
'On pointe le champs de recherche
Set MyLi = IEDoc.all("champs")
'On définit le texte que l'on souhaite placer à l'intérieur siret
MyLi.Value = Sheets("produits a base de viande").Cells(i, 2).Value
'On pointe notre bouton
Set InputBtnTrouver = IEDoc.getElementById(ID_INPUT_BUTTON_TROUVER)
'On simule un clic
InputBtnTrouver.Click
'On attend le chargement complet de la page
WaitIE IE
'On pointe le membre Document
Set IEDoc = IE.document
WaitDoc IEDoc
'on pointe le lien fiche entreprise
Set Stepsearch = IEDoc.getElementById(ID_INPUT_SIREN)
Set InputSiren = Stepsearch.Children(4).Children(0)
'On simule un clic
InputSiren.Click
'On attend le chargement complet de la page
WaitIE IE
'On pointe le membre Document
Set IEDoc = IE.document
WaitDoc IEDoc
'on recupère les données
'CA
Set CA = IEDoc.getElementById(ID_CA).Children(0)
CAtext = CA.innerText
'EF
Set EF = IEDoc.getElementById(ID_TAB).Children(0).Children(10).Children(1)
EFtext = EF.innerText
'NAF
Set NAF = IEDoc.getElementById(ID_TAB).Children(0).Children(6).Children(1)
NAFtext = NAF.innerText
Sheets("produits a base de viande").Cells(i, 8) = CA.innerText
Sheets("produits a base de viande").Cells(i, 9) = EF.innerText
Sheets("produits a base de viande").Cells(i, 10) = NAF.innerText
Next i
<div class="monocadre" id="etablissement" abp="362">
<h3 abp="363">L'établissement</h3>
<table id="etab" cellspacing="0" cellpadding="0" abp="364">
<p class="buttbluer" abp="432"></p>
<div class="clearboth" abp="434"></div>
<p class="buttbluer" abp="435"><a onclick="ga('send', 'event', 'Fiche_entreprise', 'Onglet-etablissement', 'voir_la_fiche_entreprise');" href="/societe/a-la-source-780028296.html" abp="436">Voir la fiche de l'entreprise</a></p>
</div>
<div class="monocadre" id="etablissement" abp="362">
<h3 abp="363">L'établissement</h3>
<table id="etab" cellspacing="0" cellpadding="0" abp="364">
<div class="clearboth" abp="432"></div>
<p class="buttbluer" abp="433"><a onclick="ga('send', 'event', 'Fiche_entreprise', 'Onglet-etablissement', 'voir_la_fiche_entreprise');" href="/societe/abattoir-et-decoupes-des-tuileries-507518298.html" abp="434">Voir la fiche de l'entreprise</a></p>
</div>
Option Explicit
Const TXT_URL As String = "www.societe.com"
Const ID_CA As String = "presentationlien"
Const ID_TAB As String = "rensjur"
Const ID_INPUT_SIREN As String = "etablissement"
Const ID_INPUT_BUTTON_TROUVER As String = "buttsearch"
Sub Web()
Dim IE As New InternetExplorer
Dim IEDoc As HTMLDocument
Dim MyLi As HTMLInputElement
Dim InputSiren As HTMLInputButtonElement
Dim InputBtnTrouver As HTMLInputButtonElement
Dim Stepsearch As IHTMLElement
Dim CA As HTMLGenericElement
Dim CAtext As String
Dim i
Dim j
Dim htmlTabResultat As HTMLGenericElement
Dim htmlLigneResultat As HTMLGenericElement
For i = 2 To 2310
'Chargement d'une page Web societe.com
IE.navigate TXT_URL
'affichage de la page
IE.Visible = True
'On attend le chargement complet de la page
WaitIE IE
'On pointe le membre Document
Set IEDoc = IE.document
WaitDoc IEDoc
'On pointe le champs de recherche
Set MyLi = IEDoc.all("champs")
'On définit le texte que l'on souhaite placer à l'intérieur siret
MyLi.Value = Sheets("produits a base de viande").Cells(i, 2).Value
'On pointe notre bouton
Set InputBtnTrouver = IEDoc.getElementById(ID_INPUT_BUTTON_TROUVER)
'On simule un clic
InputBtnTrouver.Click
'On attend le chargement complet de la page
WaitIE IE
'On pointe le membre Document
Set IEDoc = IE.document
WaitDoc IEDoc
'on pointe le lien fiche entreprise
Set Stepsearch = IEDoc.getElementById(ID_INPUT_SIREN)
On Error GoTo LineSAUT
If Stepsearch.Children.Length = 5 Then
Set InputSiren = Stepsearch.Children(4).Children(0)
ElseIf Stepsearch.Children.Length = 4 Then
Set InputSiren = Stepsearch.Children(3).Children(0)
End If
'On simule un clic
InputSiren.Click
'On attend le chargement complet de la page
WaitIE IE
'On pointe le membre Document
Set IEDoc = IE.document
WaitDoc IEDoc
'on recupère les données
Set htmlTabResultat = IEDoc.getElementById(ID_TAB).Children(0)
j = 8
For Each htmlLigneResultat In htmlTabResultat.Children
Sheets("produits a base de viande").Cells(i, j) = htmlLigneResultat.Children(0).innerText
Sheets("produits a base de viande").Cells(i, j + 1) = htmlLigneResultat.Children(1).innerText
j = j + 2
Next
'CA
Set CA = IEDoc.getElementById(ID_CA).Children(0)
CAtext = CA.innerText
Sheets("produits a base de viande").Cells(i, j) = CA.innerText
LineSAUT:
Next i
End Sub
Sub WaitIE(IE As InternetExplorer)
Do Until IE.readyState = READYSTATE_COMPLETE
DoEvents
Loop
End Sub
Sub WaitDoc(doc As HTMLDocument)
Do While Not doc.readyState = "complete"
DoEvents
Loop
End Sub