使用面临错误的 VBA 从网站中提取超链接

Question

我正在尝试从我输入的网页中提取所有包含“http://www.bursamalaysia.com/market/listed-companies/company-announcements/”的超链接。

首先，代码运行良好，但之后我遇到了无法提取所需 url 链接的问题。每次我运行 sub 时它都会丢失。

链接：http://www.bursamalaysia.com/market/listed-companies/company-announcements/#/?category=SH&sub_category=all&alphabetical=All

Sub scrapeHyperlinks()

    Dim IE As InternetExplorer
    Dim html As HTMLDocument
    Dim ElementCol As Object
    Dim Link As Object
    Dim erow As Long
    Application.ScreenUpdating = False
    Set IE = New InternetExplorer


    For u = 1 To 50
    IE.Visible = False
    IE.navigate Cells(u, 2).Value
    Do While IE.readyState <> READYSTATE_COMPLETE
    Application.StatusBar = "Trying to go to websitehahaha"
    DoEvents

    Loop
    Set html = IE.document
    Set ElementCol = html.getElementsByTagName("a")
    For Each Link In ElementCol
    erow = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
    Cells(erow, 1).Value = Link
    Cells(erow, 1).Columns.AutoFit
    Next
    Next u

    ActiveSheet.Range("$A$1:$A$152184").AutoFilter Field:=1, Criteria1:="http://www.bursamalaysia.com/market/listed-companies/company-announcements/???????", Operator:=xlAnd

    For k = 1 To [A65536].End(xlUp).Row
    If Rows(k).Hidden = True Then
    Rows(k).EntireRow.Delete
    k = k - 1
    End If
    Next k


    Set IE = Nothing
    Application.StatusBar = ""
    Application.ScreenUpdating = True
End Sub

Answer 1

只是为了获得您从给定 URL 中提到的合格hrefs，我将使用以下内容。它使用 CSS 选择器组合来定位指定页面中感兴趣的 URL。

CSS 选择器组合是

#bm_ajax_container [href^='/market/listed-companies/company-announcements/']

这是一个descendant selector，正在寻找属性为href 的元素，其值以/market/listed-companies/company-announcements/ 开头，并且父元素的id 为bm_ajax_container。该父元素是 ajax 容器 div。 "#" 是一个 id 选择器，“[]”表示一个属性选择器。 "^" 表示以开头。

容器 div 和第一个匹配的 href 示例：

由于要匹配多个元素，因此通过 querySelectorAll 方法应用 CSS 选择器组合。这将返回一个nodeList，可以遍历其.Length，以按索引访问各个项目。

完整的合格链接被写到工作表中。

---

使用选择器的页面 CSS 查询结果示例（示例）：

---

VBA：

Option Explicit
Public Sub GetInfo()
    Dim IE As New InternetExplorer
    Application.ScreenUpdating = False
    With IE
        .Visible = True
        .navigate "http://www.bursamalaysia.com/market/listed-companies/company-announcements/#/?category=SH&sub_category=all&alphabetical=All"

        While .Busy Or .readyState < 4: DoEvents: Wend

        Dim links As Object, i As Long
        Set links = .document.querySelectorAll("#bm_ajax_container [href^='/market/listed-companies/company-announcements/']")
        For i = 0 To links.Length - 1
            With ThisWorkbook.Worksheets("Sheet1")
                .Cells(i + 1, 1) = links.item(i)
            End With
        Next i
        .Quit
    End With
    Application.ScreenUpdating = True
End Sub