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
| Declare Function GetTickCount Lib "kernel32" () As Long
Public Sub RecupInfosSelenium() 'J.P Décembre 2020
Dim robot As New WebDriver
Dim elem, fiche, zone, Map, Titre, Identité As Object
Dim Page, ListePages As Object
Dim ReleveLink, ReleveLiensFiches As Object
Dim Mat As Matière
Dim arrPages As New ArrayList
Dim arrFiches As New ArrayList
Dim lastPage, i As Integer
Dim laPage As String
Dim StartTime, StopTime As Long
Dim reg As New RegExp: reg.Global = True: reg.Pattern = "(\d+)"
Dim reg1 As New RegExp: reg1.Global = True: reg1.Pattern = "(<SPAN>.*</SPAN>)"
Dim reg2 As New RegExp: reg2.Global = True: reg2.Pattern = "<[^>]*>"
Debug.Print "Récupération Infos Matières en utilisant Selenium"
' Récupération url de toutes les pages des matières
StartTime = GetTickCount
' robot.AddArgument "--headless" ' mode invisible
robot.Timeouts.ImplicitWait = 10000 ' temps max 8 secondes pour les commandes find avant exception
robot.Start "chrome", "https://olfatheque.com/"
robot.Get "/recherche.php?d=matiere&term=tout"
' recherche des pages
Set ListePages = robot.FindElementsByXPath("//ul[@class='pagination']/li")
For Each Page In ListePages
'Debug.Print Page.Attribute("clck")
laPage = Page.Attribute("clck")
Set Matches = reg.Execute(Page.Attribute("clck"))
lastPage = Matches(0)
Next Page
For i = 0 To lastPage
arrPages.Add "/" + reg.Replace(laPage, i)
Next
For Each Page In arrPages
robot.Get Page
Set ReleveLiensFiches = robot.FindElementsByXPath("//div[@clck]")
For Each ReleveLink In ReleveLiensFiches
Set Mat = New Matière
'Debug.Print ReleveLink.Attribute("clck") ' on affiche les liens
Mat.Lien = "/" + ReleveLink.Attribute("clck")
arrFiches.Add Mat
Next
Next Page
StopTime = GetTickCount
Debug.Print "temps écoulé recherche de toutes les pages à explorer : " & (StopTime - StartTime) & " ms"
' Récupération infos de toutes les pages des matières
StartTime = GetTickCount
For Each fiche In arrFiches
robot.Get fiche.Lien
Set Titre = robot.FindElementsByXPath("//div[@class='fiche-title']/h1 | //div[@class='fiche-title']/h2")
For Each elem In Titre
If elem.tagname = "h1" Then fiche.Nom = elem.Text
If elem.tagname = "h2" Then fiche.NomLatin = elem.Text
Next
Set Identité = robot.FindElementsByXPath("//div[@id='recap']/p")
For Each elem In Identité
Select Case Trim(elem.FindElementByTag("span").Text)
Case "Type"
fiche.LeType = Mid(elem.Text, InStr(1, elem.Text, Chr(10)) + 1, _
Len(elem.Text) - InStr(1, elem.Text, Chr(10)))
Case "Obtention"
fiche.Obtention = Mid(elem.Text, InStr(1, elem.Text, Chr(10)) + 1, _
Len(elem.Text) - InStr(1, elem.Text, Chr(10)))
Case "Origine"
fiche.Origine = Mid(elem.Text, InStr(1, elem.Text, Chr(10)) + 1, _
Len(elem.Text) - InStr(1, elem.Text, Chr(10)))
Case "Partie utilisée"
fiche.PartieUtilisée = Mid(elem.Text, InStr(1, elem.Text, Chr(10)) + 1, _
Len(elem.Text) - InStr(1, elem.Text, Chr(10)))
Case "Famille / Facette"
fiche.FamilleFacette = Mid(elem.Text, InStr(1, elem.Text, Chr(10)) + 1, _
Len(elem.Text) - InStr(1, elem.Text, Chr(10)))
Case "Nombre de Parfums"
fiche.NbParfums = Mid(elem.Text, InStr(1, elem.Text, Chr(10)) + 1, _
Len(elem.Text) - InStr(1, elem.Text, Chr(10)))
End Select
Next
Set elem = robot.FindElementByXPath("//a[@href='#map']", timeout:=0, Raise:=False)
If Not elem Is Nothing Then elem.Click
robot.Wait (500)
Set Map = robot.FindElementsByXPath("//ul[@class='map-zone']")
For Each zone In Map
fiche.ZoneGéo = zone.Text
Next
Next
StopTime = GetTickCount
Debug.Print "temps écoulé récupération infos de toutes les pages à explorer : " & (StopTime - StartTime) & " ms"
' Remplissage feuille Excel
StartTime = GetTickCount
i = 2
For Each fiche In arrFiches
Sheets("Matières").Cells(i, 1).Value = fiche.Nom
Sheets("Matières").Cells(i, 2).Value = fiche.NomLatin
Sheets("Matières").Cells(i, 3).Value = fiche.LeType
Sheets("Matières").Cells(i, 4).Value = fiche.Obtention
Sheets("Matières").Cells(i, 5).Value = fiche.Origine
Sheets("Matières").Cells(i, 6).Value = fiche.PartieUtilisée
Sheets("Matières").Cells(i, 7).Value = fiche.FamilleFacette
Sheets("Matières").Cells(i, 8).Value = fiche.NbParfums
Sheets("Matières").Cells(i, 9).Value = fiche.ZoneGéo
Sheets("Matières").Cells(i, 10).Value = fiche.Lien
i = i + 1
Next
StopTime = GetTickCount
Debug.Print "temps écoulé remplissage feuille excel : " & (StopTime - StartTime) & " ms"
robot.Wait (5000) ' laisser le téléchargement s'effectué
robot.Quit ' fermeture de fenêtre google chrome
End Sub |