Comment get datatables des enfants d'un élément HTML parent spécifique dans VBA

Encore une fois, je me trouve confronté à un problème très spécifique. Je suis assez nouveau pour VBA, et surtout HTML, alors supportez-moi. J'ai construit un correcteur Web fonctionnel dans VBA, mais il y a quelques tâches spécifiques que je veux accomplir que je ne peux pas comprendre.

Voici l'échantillon HTML auquel se réfère ma question.

J'ai remplacé toutes les choses qui n'ont pas d'importance avec les ellipses. La partie importante que je veux racler est dans les balises "a", le "data shorturl" (ou juste le innerText ). C'est un nom de site Web. Il y en a cinq, mais il n'y a pas toujours cinq. Il s'agit également d'une section de deux sections avec jusqu'à cinq sites Web répertoriés. La section affichée a les enfants de <div class="referralsSites referring"> , et l'autre a les enfants de <div class="referralsSites destination"> .

Chaque site Web dans la section "referencement" que je veux atsortingbuer aux variables "Up" – le premier site Web affecté à "Up1", le second à "Up2", etc., mais seulement selon le nombre de sites Web dans " se référant ". Je veux faire la même chose dans la section "destination", mais affecté aux variables "Down" (Down1, Down2, etc.) en fonction du nombre de sites de destination.

Si je devais simplement utiliser getElementsByClassName("websitePage-listItemLink js-tooltipTarget") , par exemple, je ne serais pas en mesure de différencier les sites de reference et de destination.

Voici mon code jusqu'à présent:

 Sub GetSimilarWebData() Dim appIE As InternetExplorer Dim HTML As HTMLDocument Dim ieWindow As SHDocVw.InternetExplorer Dim URL As Ssortingng Dim Rankings As IHTMLElementCollection, Traffic As IHTMLElementCollection, ReferSites As IHTMLElementCollection, DestSites As IHTMLElementCollection, _ rSite As IHTMLElement, rSiteNo As Long, dSite As IHTMLElement, dSiteNo As Long, GlobalRank As Ssortingng, CountryName As Ssortingng, CountryRank As Ssortingng, _ Visits As Ssortingng, Direct As Ssortingng, Refer As Ssortingng, Search As Ssortingng, Social As Ssortingng, Display As Ssortingng, _ Up1 As Ssortingng, Up2 As Ssortingng, Up3 As Ssortingng, Up4 As Ssortingng, Up5 As Ssortingng, _ D1 As Ssortingng, D2 As Ssortingng, D3 As Ssortingng, D4 As Ssortingng, D5 As Ssortingng Dim FraudLast As Long CheckLast = Worksheets("Sheet1").Range("I1").End(xlDown).Offset(1).Row webStr = Worksheets("Sheet1").Range("A" & CheckLast).Value Set appIE = New InternetExplorer appIE.Visible = False appIE.navigate "https://www.similarweb.com/website/" & webStr Do While appIE.readyState <> READYSTATE_COMPLETE Application.StatusBar = "Connecting to SimilarWeb..." DoEvents Loop Set HTML = appIE.document Set appIE = Nothing Application.StatusBar = "" Set Rankings = HTML.getElementsByClassName("rankingItem-value") GlobalRank = Rankings(0).innerText If GlobalRank = "N/A" Then GlobalRank = "null" CountryName = "null" CountryRank = "null" Else CountryName = HTML.getElementsByClassName("rankingItem-subTitle")(1).innerText CountryRank = Rankings(1).innerText End If Visits = HTML.getElementsByClassName("engagementInfo-value engagementInfo-value--large u-text-ellipsis")(0).innerText If InStr(Visits, "M") <> 0 Then Visits = Replace(Visits, ".", "") Visits = Replace(Visits, "M", "00000") ElseIf InStr(Visits, "K") <> 0 Then Visits = Replace(Visits, ".", "") Visits = Replace(Visits, "K", "00") ElseIf InStr(Visits, "B") <> 0 Then Visits = Replace(Visits, ".", "") Visits = Replace(Visits, "B", "00000000") End If Set Traffic = HTML.getElementsByClassName("trafficSourcesChart-value") Direct = Traffic(0).innerText Refer = Traffic(1).innerText Search = Traffic(2).innerText Social = Traffic(3).innerText Display = Traffic(4).innerText 'Here's what I've started off with: Set ReferSite = HTML.getElementsByClassName("referralsSites referring") rSiteNo = ReferSite.Length Set DestSite = HTML.getElementsByClassName("referralsSites destination") dSiteNo = DestSite.Length 'For Each rSite In ReferSite End Sub 

Je ne sais pas vraiment comment aborder le problème. Tout le rest de mon code fonctionne bien, mais bien sûr, s'il y a quelque chose que je puisse faire pour améliorer la vitesse qui serait également le bienvenue.

Tout cela se réfère à des données sur similarweb.com.

La méthode getElementsByClassName peut être utilisée sur un object IHTMLElement ainsi que sur un object HTMLDocument . Cela signifie que vous pouvez get les lists séparées de sites de recommandation et de destination dans deux «sauts».

Obtenez d'abord les <div> s avec le nom de class de referralsSites referring ou referralsSites destination . La méthode getElementsByClassName renvoie un IHTMLElementCollection qui est une collection d' IHTMLElement . Donc, vous obtenez le 0ème élément de la collection (en supposant qu'il n'y ait qu'un seul <div> ), puis obtenez le <a> s dans ce <div> avec une class de websitePage-listItemLink en appelant la méthode getElementsByClassName nouveau sur IHTMLElement pour le <div> .

Voici un exemple pour stackoverflow.com – Je fais juste Debug.Print de la sortie, mais vous voudrez peut-être atsortingbuer les noms de sites dans un tableau, ou Collection ou quelque chose.

 Option Explicit Sub Test() 'references required: 'Microsoft HTML Object Library 'Microsoft Internet Controls Dim strUrl As Ssortingng Dim objIe As InternetExplorer Dim objHtml As HTMLDocument Dim strHtml As Ssortingng Dim objDivs As IHTMLElementCollection Dim objAnchors As IHTMLElementCollection Dim intCounter As Integer 'set target to scrape strUrl = "https://www.similarweb.com/website/stackoverflow.com" 'get html from page Set objIe = New InternetExplorer objIe.Visible = False objIe.navigate strUrl While objIe.readyState <> READYSTATE_COMPLETE DoEvents Wend 'assign html to DOM document Set objHtml = New HTMLDocument Set objHtml = objIe.document 'get referrals Set objDivs = objHtml.getElementsByClassName("referralsSites referring") If objDivs.Length > 0 Then Set objAnchors = objDivs(0).getElementsByClassName("websitePage-listItemLink") Debug.Print "Referrers:" If objAnchors.Length > 0 Then For intCounter = 0 To objAnchors.Length - 1 Debug.Print objAnchors(intCounter).innerText Next intCounter End If End If 'get destinations Set objDivs = objHtml.getElementsByClassName("referralsSites destination") If objDivs.Length > 0 Then Set objAnchors = objDivs(0).getElementsByClassName("websitePage-listItemLink") Debug.Print "Destinations:" If objAnchors.Length > 0 Then For intCounter = 0 To objAnchors.Length - 1 Debug.Print objAnchors(intCounter).innerText Next intCounter End If End If 'clean up Set objHtml = Nothing objIe.Quit Set objIe = Nothing End Sub 

Cela donne une sortie de:

 Referrers: news.ycombinator.com qwant.com github.com remoteok.io serverfault.com Destinations: jsfiddle.net youtube.com github.com i.stack.imgur.com w3schools.com