使用 getElementsByTagName() 进行网页抓取

Question

我想将餐厅名称、phone 号码、网站和地址等餐厅数据导入 excel，但不幸的是，我得到的是广告和垃圾数据。我使用 http://automatetheweb.net/vba-getelementsbytagname-method/ 网站创建了一个代码，但它没有帮助。请纠正我的代码中的问题。网站：https://www.yellowpages.com/atlanta-ga/attorneys
请不要参考 json，因为它在其他网站上不起作用。

Sub Yellowcom()
    'Dim ieObj As InternetExplorer
    Dim htmlELe As IHTMLElement
    Dim HTML As HTMLDocument
    Dim i As Integer

    Dim URL As String
    Dim URLParameter As String
    Dim page As Long
    Dim links As Object
    Dim IE As Object


    i = 1

    Set IE = CreateObject("InternetExplorer.Application")
    'Set ieObj = New InternetExplorer
    IE.Visible = True
    URL = "https://www.yellowpages.com/atlanta-ga/attorneys"
    'Application.Wait Now + TimeValue("00:00:05")

    For page = 2 To 4

        If page > 1 Then URLParameter = "?page=" & page

        IE.navigate URL & URLParameter

        ' Wait for the browser to load the page
        Do Until IE.readyState = 4

            DoEvents

        Loop

        Set HTML = IE.document
        Set links = HTML.getElementsByClassName("info")

    For Each htmlELe In links

        With ActiveSheet
            .Range("A" & i).Value = htmlELe.Children(0).textContent
            .Range("B" & i).Value = htmlELe.getElementsByTagName("a")(0).href
            .Range("C" & i).Value = htmlELe.Children(2).textContent
            .Range("D" & i).Value = htmlELe.Children(2).querySelector("a[href]")
             'links2 = htmlELe.getElementsByClassName("links")(1)
           ' .Range("D" & i).Value = links2.href


        End With
    i = i + 1

    Next htmlELe

    Next page

    IE.Quit
    Set IE = Nothing

    End Sub

要求的输出应该是这样的

Answer 1

信息class也用于广告。您首先需要前往 class 名称为 "search-results organic" 的集合，然后在其中找到所有 "info" classes.

这意味着您需要一个额外的集合变量：

Set HTML = IE.document
Set OrganicLinks = HTML.getElementsByClassName("search-results organic")
Set links = OrganicLinks.item(0).getElementsByClassName("info")

要获得正确的网站，您需要使用其他参考。最好通过 classname 获取它，因为那个更独特：

On Error Resume Next
.Range("B" & i).Value = htmlELe.getElementsByClassName("track-visit-website")(0).href
On Error GoTo 0

Answer 2

我会使用 xhr 而不是浏览器，并将每个页面的数据存储在一个数组中，然后将其写出到 sheet。你真的可以根据每页的结果和页数来确定一个数组的维度来提前保存所有结果，但下面仍然有效

Option Explicit
Public Sub GetListings()
    Dim html As HTMLDocument, page As Long, html2 As HTMLDocument
    Dim results As Object, headers(), ws As Worksheet, i As Long

    Const START_PAGE As Long = 1
    Const END_PAGE As Long = 2

    Set ws = ThisWorkbook.Worksheets("Sheet1")
    headers = Array("Name", "Phone", "Website", "Address")
    Application.ScreenUpdating = False
    Set html = New HTMLDocument
    Set html2 = New HTMLDocument
    ws.Cells(1, 1).Resize(1, UBound(headers) + 1) = headers

    With CreateObject("MSXML2.XMLHTTP")
        For page = START_PAGE To END_PAGE
            .Open "GET", "https://www.yellowpages.com/atlanta-ga/attorneys?page=" & page, False
            .send
            html.body.innerHTML = .responseText
            Set results = html.querySelectorAll(".organic .result")
            Dim output(), r As Long
            ReDim output(1 To results.Length, 1 To 4)
            r = 1
            For i = 0 To results.Length - 1
                On Error Resume Next
                html2.body.innerHTML = results.item(i).outerHTML
                output(r, 1) = html2.querySelector(".business-name").innerText
                output(r, 2) = html2.querySelector(".phone").innerText
                output(r, 3) = html2.querySelector(".track-visit-website").href
                output(r, 4) = html2.querySelector(".street-address").innerText & " " & html2.querySelector(".locality").innerText
                On Error GoTo 0
                r = r + 1
            Next
            ws.Cells(GetLastRow(ws, 1) + 1, 1).Resize(UBound(output, 1), UBound(output, 2)) = output
        Next
    End With
    Application.ScreenUpdating = True
End Sub
Public Function GetLastRow(ByVal ws As Worksheet, Optional ByVal columnNumber As Long = 1) As Long
    With ws
        GetLastRow = .Cells(.rows.Count, columnNumber).End(xlUp).Row
    End With
End Function

输出样本：

使用 getElementsByTagName() 进行网页抓取

Web scraping with getElementsByTagName()

excel

vba

web-scraping

getelementsbyclassname