无法解析网页中的所有链接答案

【问题标题】：Unable to parse all the links from a webpage无法解析网页中的所有链接
【发布时间】：2017-11-19 16:37:35
【问题描述】：

不知道如何从代码中使用的页面获取所有公司链接。运行我的脚本，我只得到 20 个链接。该页面具有延迟加载方法，这就是为什么我无法获得所有这些方法。对此的任何意见将不胜感激。到目前为止，我已经尝试过：

Sub Company_links()
Const lnk = "http://fortune.com"
Dim http As New XMLHTTP60, html As New HTMLDocument
Dim topic As Object

With http
    .Open "GET", "http://fortune.com/fortune500/list/", False
    .send
    html.body.innerHTML = .responseText
End With

For Each topic In html.getElementsByClassName("small-12 column row")
    x = x + 1
    With topic.getElementsByTagName("a")
        If .Length Then Cells(x, 1) = lnk & Split(.item(0).href, "about:")(1)
    End With
Next topic

Set html = Nothing: Set topics = Nothing
End Sub

【问题讨论】：

如果站点使用 ajax 加载剩余的链接。您需要先让页面加载那些剩余的链接。

标签： vba web-scraping web-crawler

【解决方案1】：

在新工作簿中运行以下代码。无论结果是否为空，它都会将结果输出到 Sheet1，所以如果那里有数据，请小心。以后可以随意更改这部分代码。

首先，您需要在 VBA 编辑器中从 Tools -> References 激活 Microsoft HTML Object Library 和 Microsoft Internet Controls。然后运行以下代码，高枕无忧，直到看到“All Done！”留言：

Sub Company_links()
    Dim i As Long
    Dim aIE As InternetExplorer
    Dim Rank As IHTMLElement, Company As IHTMLElement, Revenues As IHTMLElement
    Set aIE = New InternetExplorer
    With aIE
        .navigate "http://fortune.com/fortune500/list/"
        .Visible = True
    End With

    Do While (aIE.Busy Or aIE.ReadyState <> READYSTATE_COMPLETE)
        DoEvents
    Loop

    For i = 1 To 50

        On Error Resume Next
        Set Rank = aIE.document.getElementsByClassName("column small-2 company-rank")(999)
        If Rank Is Nothing Then
            GoTo Skip
        End If
        Exit For
Skip:
    SendKeys "{end}"
    Application.Wait (Now() + TimeValue("00:00:005"))
    Next i

    With Sheet1
        .Range("A1") = "RANK"
        .Range("B1") = "COMPANY"
        .Range("C1") = "REVENUE"

        For i = 0 To 999
            Set Rank = aIE.document.getElementsByClassName("column small-2 company-rank")(i)
            Set Company = aIE.document.getElementsByClassName("column small-5 company-title")(i)
            Set Revenues = aIE.document.getElementsByClassName("column small-5 company-revenue")(i)
            .Range("A" & i + 2) = Rank.innerText
            .Range("B" & i + 2) = Company.innerText
            .Range("C" & i + 2) = Revenues.innerText
        Next i

    End With

    SendKeys "%{F4}"
    Set aIE = Nothing
    Set Rank = Nothing
    Set Company = Nothing
    Set Revenues= Nothing
    MsgBox "All Done!"
End Sub

【讨论】：

感谢 Tehscript，您的回答。我完成后会回复你。顺便说一句，你一直对我帮助很大。
@SMth80 没问题，但我刚刚注意到您需要公司链接。你能设法改变这段代码吗？因为这个脚本给出了排名、公司名称和收入。
没问题，我会处理的。您的代码照常工作。现在我要稍微抽一下来用 xmlhttp 制作它，因为我从你那里得到了一个想法。非常感谢。
@SMth80 欢迎您。如果您遇到困难，请告诉我。
您好 Tehscript，在您的空闲时间，您可以查看该链接。 "stackoverflow.com/questions/45200247/…"

【解决方案2】：

如果站点使用 ajax 加载剩余的链接。您需要先让页面加载那些剩余的链接。我的建议是使用 selenium 加载页面，然后使用您的代码获取链接。

http://selenium-python.readthedocs.io/

【讨论】：

对不起，ANKIT GAUR 兄弟。我试过用硒。那也不能带来所有的链接。与我的第一个代码一样，这也带来了 20 个链接。问题在别处。链接中必须有一个分页选项（通常有），但无法弄清楚它是如何放置的。

【解决方案3】：

我会这样做的。

Option Explicit

Sub Sample()
    Dim ie As Object
    Dim links As Variant, lnk As Variant
    Dim rowcount As Long

    Set ie = CreateObject("InternetExplorer.Application")
    ie.Visible = True
    ie.navigate "http://fortune.com"

    'Wait for site to fully load
    'ie.Navigate2 URL
    Do While ie.Busy = True
       DoEvents
    Loop

    Set links = ie.document.getElementsByTagName("a")

    rowcount = 1

    With Sheets("Sheet1")
        For Each lnk In links
        'Debug.Print lnk.innerText
            'If lnk.classname Like "*Real Statistics Examples Part 1*" Then
                .Range("A" & rowcount) = lnk.innerText
                rowcount = rowcount + 1
                'Exit For
            'End If
        Next
    End With
End Sub

【讨论】：