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 113
| Option Explicit
'Déclaration des variables globales
Dim IE As Object 'Pas de référence à activer en late binding
Sub test_Alsaeco_Com()
cherche_societe , , , , , , 67, "0146Z" ' entre chaque virgule vont les données correspondant au argument de la fonction cherche dans le meme ordre
End Sub
Function cherche_societe(Optional raison As String = "", Optional siret As String = "", Optional siren As String = "", Optional nom_dirigant As String = "", Optional prenom_dirigant As String = "", Optional commune As String = "", Optional departement As String = "", Optional ape As String = "")
'Déclaration des variables
Dim IEDoc As Object
Dim elem As Object
Dim mon_elem As Object
Dim TagHtml_a As Object
Dim URL As Variant
Dim tabURL As Variant
Dim i As Integer, i_0 As Integer, i_n As Integer, page As Integer, nbPages As Integer, nbSocietes As Integer
'Initialisation des variables
page = 1
ReDim URL(1 To page)
ReDim tabURL(1 To 1)
URL(1) = "http://www.alsaeco.com/entreprises/recherche.html?aeadirectoryParam[raison]=" & raison & "&aeadirectoryParam[siret]=" & siret & "&aeadirectoryParam[siren]=" & siren & "&aeadirectoryParam[commune]=" & commune & "&aeadirectoryParam[departement]=" & departement & "&aeadirectoryParam[dirigeant]=" & nom_dirigant & "&aeadirectoryParam[ape]=" & ape & "&aeadirectoryParam[submit]=Rechercher"
'Accès au site web
OuvreLien URL(1)
Set IEDoc = IE.document 'On pointe le membre Document
'Nombre de pages
For Each elem In IEDoc.all
If elem.className = "link last-page" Then 'On cherche le lien pointant sur la dernière page
nbPages = Val(StrReverse(Val(StrReverse(elem.href)))) 'On récupère le numéro de la dernière page présent dans les derniers caractères du lien, et qui représente le nombre de pages
Debug.Print "Nombre de pages = " & nbPages 'Le résultat s'affiche dans la fenêtre d'execution de l'éditeur de macros
Exit For
End If
Next
'Navigation sur chacune des pages et création du tableau tabURL
For page = 1 To nbPages 'On crée un tableau contenant l'ensemble des URL vers les fiches de chaque société
ReDim Preserve URL(1 To page)
URL(page) = URL(1) & "&aeadirectoryParam[page]=" & page
Debug.Print "Page " & page
OuvreLien URL(page)
Set IEDoc = IE.document 'On actualise le pointage vers le membre Document de la nouvelle page
'Les entreprises sont listées dans le tableau démarrant à la balise "ul" avec pour classname "coin-plie"
For Each elem In IEDoc.all
If elem.className = "coin-plie" Then 'On liste les éléments du tableau contenant les URL vers les fiches de chaque société
Set mon_elem = elem
Exit For
End If
Next
Set TagHtml_a = mon_elem.getElementsByTagName("a") 'On liste les éléments de type anchor (chaque balise <a ...> représente un lien vers une fiche société)
If page = 1 Then
i_0 = UBound(tabURL)
ReDim tabURL(1 To UBound(tabURL) + TagHtml_a.Length - 1) 'On écrase le tableau initialement créé (de longueur 1)
Else
i_0 = UBound(tabURL) + 1
ReDim Preserve tabURL(1 To UBound(tabURL) + TagHtml_a.Length) 'On ajoute des cellules au tableau précédant en conservant les données existantes
End If
i_n = UBound(tabURL)
Debug.Print "Nb total de liens : " & UBound(tabURL)
For i = 0 To TagHtml_a.Length - 1 'On crée un tableau contenant l'ensemble des URL vers les fiches de chaque société
tabURL(i_0 + i) = TagHtml_a(i).href
Debug.Print "Société " & i_0 + i & " - " & tabURL(i_0 + i)
Next
Next
nbSocietes = UBound(tabURL)
Debug.Print "Nb total de sociétés recensées : " & nbSocietes
MsgBox "Scan terminé"
IE.Quit 'Fermeture de l'instance d'IE (à inclure obligatoirement si IE.Visible = False)
'Libération des variables
Set IE = Nothing
Set IEDoc = Nothing
End Function
' Verifie si IE déjà lancé et le relance si c'est pas le cas
' !! Attention utilise une variable globale IE as Internet Explorer...
'
Sub VerifieIE()
On Error GoTo CreerIE
If Not IE Is Nothing Then
IE.Visible = True
Exit Sub
End If
CreerIE:
Set IE = CreateObject("InternetExplorer.Application")
IE.Visible = True 'Affichage de la fenêtre IE
End Sub
Sub OuvreLien(URL As String)
VerifieIE
IE.Navigate URL
WaitIE IE 'On attend le chargement complet de la page
Debug.Print "Fin ouverture " & URL
End Sub
Sub WaitIE(IE)
'On boucle tant que la page n'est pas totalement chargée
Do While IE.readyState <> 4 Or IE.busy
DoEvents
Loop
End Sub |
Partager