VBA内の特定の親HTML要素の子からデータを取得する方法

Question

もう一度自分自身に非常に具体的な問題が発生しています。私はVBA、そして特にHTMLの新機能ですから、私にも負担してください。私はVBAに機能しているWebスクレーパーを構築しましたが、私が理解できないようにいくつかの具体的なタスクがあります。

Here is the HTML sample that my question refers to.

私は楕円とは関係ありません。すべてのものを交換しました。重要な部分は、 "a"タグ、 "data-shorturl"（またはちょうどinnerText）です。これはウェブサイト名です。これらは5つまでありますが、必ずしも5つあるとは限りません。これは、最大5つのWebサイトがリストされた2つのセクションの1つにすぎません。投稿されたセクションの子は<div class="referralsSites referring">、もう一方の子は<div class="referralsSites destination">です。

「参照」セクションの各ウェブサイト「アップ」変数に割り当てたい最初のウェブサイト（「アップ1」、2番目の「アップ2」など）は、いくつのウェブサイト「参照」セクションにあります。私は "目的地"セクションで同じことをしたいが、そこにいくつの目的地サイトがあるかに応じて "下"変数（Down1、Down2など）に割り当てられる。

たとえば、getElementsByClassName("websitePage-listItemLink js-tooltipTarget")を使用する場合、参照先と送信先のサイトを区別できません。ここで

は、これまでの私のコードです：

Sub GetSimilarWebData() 
    Dim appIE As InternetExplorer 
    Dim HTML As HTMLDocument 
    Dim ieWindow As SHDocVw.InternetExplorer 
    Dim URL As String 
    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 String, CountryName As String, CountryRank As String, _ 
     Visits As String, Direct As String, Refer As String, Search As String, Social As String, Display As String, _ 
     Up1 As String, Up2 As String, Up3 As String, Up4 As String, Up5 As String, _ 
     D1 As String, D2 As String, D3 As String, D4 As String, D5 As String 
    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 

は、私が問題にアプローチする方法が本当にわかりません。私のコードの中の他のものはうまくいきますが、スピードを上げるためにできることがあれば、それも歓迎します。

これはsimilarweb.comのデータを参照しています。

Answer 1

getElementsByClassNameメソッドは、IHTMLElementオブジェクトとHTMLDocumentオブジェクトで使用できます。つまり、2つの「ホップ」で参照先サイトと参照先サイトのリストを個別に取得できます。

まず、またはreferralsSites destinationのクラス名を持つ<div>を取得します。 getElementsByClassNameメソッドはIHTMLElementのコレクションであるIHTMLElementCollectionを返します。したがって、コレクションの0番目の要素（<div>が1つしかないと仮定します）を取得し、<div>のでgetElementsByClassNameメソッドを再度呼び出して、websitePage-listItemLinkのクラスの<div>の中の<a>を取得します。

ここにstackoverflow.comの例があります。出力のDebug.Printを実行していますが、サイト名を配列に割り当てるか、Collectionまたは何かを割り当てることができます。

Option Explicit 

Sub Test() 

    'references required: 
    'Microsoft HTML Object Library 
    'Microsoft Internet Controls 

    Dim strUrl As String 
    Dim objIe As InternetExplorer 
    Dim objHtml As HTMLDocument 
    Dim strHtml As String 
    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 

これは出力できます：

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