html - 代码中的 trs 导致运行时错误

Question

我正试图在我创建的文件夹中提取大量公司的现金流。我正在从市场观察中提取信息。我从中提取表格的网站示例是 https://www.marketwatch.com/investing/stock/aapl/financials/cash-flow .每个公司的所有 Ticker 符号都在 A 列中。我的代码在以下行中中断，并出现“运行时错误”91 错误。

Set tRow = hTable.getElementsByTagName("tr")

我知道HTML代码中有trs。另外，我为几家公司运行了代码)，然后当我再次执行它时，代码再也没有超过第一个(我第一次没有保存和关闭功能，因为我正在测试所以我退出了我所做的每一个工作簿并且我没有保存它们)。

Public Sub Companies()
Dim sResponse As String, html As HTMLDocument, hTable As Object

Application.ScreenUpdating = False


Dim Last As Long
Dim i As Integer
Dim ws As Worksheet

Last = Cells(Rows.Count, "A").End(xlUp).Row
For i = Last To 572 Step -1

M = 0

Workbooks.Open "C:***\Desktop\Stock Portfolio\Stock Valuations\Temporary Valuations\" & Cells(i, "A").Value & ".xlsx"

ThisWorkbook.Activate
Set ws = Workbooks(Cells(i, "A").Value).Sheets.Add(After:= _
         Workbooks(Cells(i, "A").Value).Sheets(Workbooks(Cells(i, "A").Value).Sheets.Count))
ws.Name = "Cash Flow"

ThisWorkbook.Activate
Set html = New HTMLDocument
With CreateObject("MSXML2.XMLHTTP")
    .Open "GET", "https://www.marketwatch.com/investing/stock/" & Cells(i, "A").Value & "/financials/cash-flow", False
    .setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"
    .send
    sResponse = StrConv(.responseBody, vbUnicode)
End With

ThisWorkbook.Activate
With html
    .body.innerHTML = sResponse
    Set hTable = .getElementsByTagName("tbody")(0)
    WriteTable hTable, 1, Workbooks(Cells(i, "A").Value).Sheets("Cash Flow")
End With

ThisWorkbook.Activate

M = 3

With html
    .body.innerHTML = sResponse
    Set hTable = .getElementsByTagName("tbody")(1)
    WriteTable hTable, 1, Workbooks(Cells(i, "A").Value).Sheets("Cash Flow")
End With
Workbooks(Cells(i, "A")).Save
Workbooks(Cells(i, "A")).Close
Next
End Sub

我使用了上面的代码，然后我使用了下面的公共(public)代码(出现问题的地方)来获取表格。

Public Sub WriteTable(ByVal hTable As Object, Optional ByVal startRow As Long = 1, Optional ByVal ws As Worksheet)
If ws Is Nothing Then Set ws = ActiveSheet
Dim tRow As Object, tCell As Object, tr As Object, td As Object, r As Long, c As Long
startRow = (M * 20) + 1
r = startRow
With ws
    Set tRow = hTable.getElementsByTagName("tr")
    For Each tr In tRow
        r = r + 1: c = 1
        Set tCell = tr.getElementsByTagName("td")
        For Each td In tCell
            .Cells(r, c).Value = td.innerText
            c = c + 1
        Next td
    Next tr
End With
End Sub

Answer 1

不是理想的答案，但请始终检查您得到的响应。此外，检查 hTable 是否为空。如果我检查响应，我会注意到该网站正在寻找机器人并使用验证码进行阻止。

Pardon Our Interruption...

As you were browsing www.marketwatch.com something about your browser made us think you were a bot. There are a few reasons this might happen:

You're a power user moving through this website with super-human speed. You've disabled JavaScript in your web browser. A third-party browser plugin, such as Ghostery or NoScript, is preventing JavaScript from running. Additional information is available in this support article.

After completing the CAPTCHA below, you will immediately regain access to www.marketwatch.com.

如果您确实是这种情况，您有几个选择:

1) 搜索信息的替代来源

2) 使用浏览器自动化(selenium basic)并希望仅此一项或适当的等待可以让您到达那里

3) 更改 IP 和用户代理。如果您最初能够针对此页面运行 XHR，那么您现在可能已被该站点添加到可疑机器人程序的监视列表中。交替使用 IP 和用户代理不是我会做的事情。