使用 VBA 提取一系列 URL

Question

我只是试图通过一个 url 链接列表运行，但它一直显示运行时错误'91'，对象变量或未设置块变量。

我要提取的数据来自 iframe。它确实显示了一些值，但它卡在进程中间并出现错误。

下面是我要从中提取值的示例 url 链接：http://www.bursamalaysia.com/market/listed-companies/company-announcements/5927201

Public Sub GetInfo()
    Dim IE As New InternetExplorer As Object
    With IE
        .Visible = False

        For u = 2 To 100

        .navigate Cells(u, 1).Value

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



        With .document.getElementById("bm_ann_detail_iframe").contentDocument
            ThisWorkbook.Worksheets("Sheet1").Cells(u, 3) = .getElementById("main").innerText
            ThisWorkbook.Worksheets("Sheet1").Cells(u, 4) = .getElementsByClassName("company_name")(0).innerText
            ThisWorkbook.Worksheets("Sheet1").Cells(u, 5) = .getElementsByClassName("formContentData")(0).innerText
            ThisWorkbook.Worksheets("Sheet1").Cells(u, 6) = .getElementsByClassName("formContentData")(5).innerText
            ThisWorkbook.Worksheets("Sheet1").Cells(u, 7) = .getElementsByClassName("formContentData")(7).innerText
            ThisWorkbook.Worksheets("Sheet1").Cells(u, 8) = .getElementsByClassName("formContentData")(8).innerText
            ThisWorkbook.Worksheets("Sheet1").Cells(u, 9) = .getElementsByClassName("formContentData")(9).innerText
            ThisWorkbook.Worksheets("Sheet1").Cells(u, 10) = .getElementsByClassName("formContentData")(10).innerText
            ThisWorkbook.Worksheets("Sheet1").Cells(u, 11) = .getElementsByClassName("formContentData")(11).innerText
       End With

    Next u
    End With
End Sub

Answer 1

tl;dr

您的错误是由于给定类名的元素数量不同，具体取决于每页的结果。所以你不能使用固定索引。对于您通过 iframe 指示该类的最后一个索引的页面是 9 即 ThisWorkbook.Worksheets("Sheet1").cells(u, 9) = .getElementsByClassName("formContentData")(9).innerText 。 10 和 11 无效。下面我展示了一种确定结果数量并从每个结果行中提取信息的方法。

一般原则：

好的...所以下面的工作原理是针对大多数信息的Details of Changes 表。

示例摘录：

更具体地说，我针对重复No, Date of Change, #Securities, Type of Transaction and Nature of Interest 信息的行。这些值存储在数组数组中（每行信息一个数组）。然后将结果数组存储在一个集合中，以便稍后写入工作表。我循环目标行中的每个表格单元格（父tr 中的td 标记元素）以填充数组。

我在页面上的表格中添加了Name，因为可能会有多行结果，具体取决于网页，并且因为我正在将结果写入新的Results 表，我在每个结果前添加URL 以表明信息来源。

---

待办事项：

1. 将代码重构为更加模块化
2. 可能会添加一些错误处理

---

CSS 选择器：

---

①我从Particulars of substantial Securities Holder表中选择Name元素，我称之为title。

名称元素示例：

检查这个元素的 HTML 显示它有一个 formContentLabel 类，并且它是页面上第一个具有这个值的类。

目标名称的示例 HTML：

这意味着我可以使用 class selector 、 .formContentLabel 来定位元素。因为它是我想要的单个元素，所以我使用 querySelector 方法来应用 CSS 选择器。

---

② 我使用.ven_table tr 的选择器组合定位Details of Changes 表中感兴趣的行。这是descendant selector 组合，将选择元素与tr 标签组合在一起，其父类为ven_table。由于这些是多个元素，我使用 querySelectorAll 方法来应用 CSS 选择器组合。

目标行示例：

---

CSS 选择器返回的示例结果（示例）：

我感兴趣的行从 1 开始，然后每 + 4 行重复一次，例如第 5 行、第 9 行等 所以我在代码中使用了一些数学来返回感兴趣的行：

Set currentRow = data.item(i * 4 + 1)

---

VBA：

Option Explicit
Public Sub GetInfo()
    Dim IE As New InternetExplorer, headers(), u As Long, resultCollection As Collection
    headers = Array("URL", "Name", "No", "Date of change", "# Securities", "Type of Transaction", "Nature of Interest")
    Set resultCollection = New Collection
    Dim links()
    links = Application.Transpose(ThisWorkbook.Worksheets("Sheet1").Range("A2:A3")) 'A100

    With IE
        .Visible = True

        For u = LBound(links) To UBound(links)
            If InStr(links(u), "http") > 0 Then
                .navigate links(u)

                While .Busy Or .readyState < 4: DoEvents: Wend
                Application.Wait Now + TimeSerial(0, 0, 1) '<you may not always need this. Or may need to increase.
                Dim data As Object, title As Object
                With .document.getElementById("bm_ann_detail_iframe").contentDocument
                    Set title = .querySelector(".formContentData")
                    Set data = .querySelectorAll(".ven_table tr")
                End With

                Dim results(), numberOfRows As Long, i As Long, currentRow As Object, td As Object, c As Long, r As Long

                numberOfRows = Round(data.Length / 4, 0)
                ReDim results(1 To numberOfRows, 1 To 7)

                For i = 0 To numberOfRows - 1
                    r = i + 1
                    results(r, 1) = links(u): results(r, 2) = title.innerText
                    Set currentRow = data.item(i * 4 + 1)
                    c = 3
                    For Each td In currentRow.getElementsByTagName("td")
                        results(r, c) = Replace$(td.innerText, "document.write(rownum++);", vbNullString)
                        c = c + 1
                    Next td
                Next i
                resultCollection.Add results
                Set data = Nothing: Set title = Nothing
            End If
        Next u
        .Quit
    End With
    Dim ws As Worksheet, item As Long
    If Not resultCollection.Count > 0 Then Exit Sub

    If Not Evaluate("ISREF('Results'!A1)") Then '<==Credit to @Rory for this test
        Set ws = Worksheets.Add
        ws.NAME = "Results"
    Else
        Set ws = ThisWorkbook.Worksheets("Results")
        ws.cells.Clear
    End If

    Dim outputRow As Long: outputRow = 2
    With ws
        .cells(1, 1).Resize(1, UBound(headers) + 1) = headers
        For item = 1 To resultCollection.Count
            Dim arr()
            arr = resultCollection(item)
            For i = LBound(arr, 1) To UBound(arr, 1)
                .cells(outputRow, 1).Resize(1, 7) = Application.WorksheetFunction.Index(arr, i, 0)
                outputRow = outputRow + 1
            Next
        Next
    End With
End Sub

---

使用 2 个提供的测试 URL 的示例结果：

---

sheet1 中的示例 URL：

1. http://www.bursamalaysia.com/market/listed-companies/company-announcements/5928057
2. http://www.bursamalaysia.com/market/listed-companies/company-announcements/5927201