运行时错误是由代码中的trs引起的



我正试图在我创建的文件夹中为一群公司提取现金流。我正在从市场观察中获取信息。我从中提取表格的网站示例是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:***DesktopStock PortfolioStock ValuationsTemporary 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 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

不是理想的答案,但请始终检查您得到的响应。Furthermmore,检查hTable是否为空。如果我检查响应,我会注意到该网站正在关注机器人并用captcha进行屏蔽。

原谅我们的中断。。。

当你浏览www.marketwatch.com时,你的浏览器让我们认为你是一个机器人可能发生:

你是一个超级用户,与超人一起浏览这个网站速度您已禁用web浏览器中的JavaScript。第三方浏览器插件,如Ghostery或NoScript,正在阻止JavaScript停止跑步。此支持中提供了其他信息文章

完成下面的CAPTCHA后,您将立即重新获得访问权限访问www.marketwatch.com。

如果你确实是这样,你有几个选择:

1( 搜索信息的替代来源

2( 使用浏览器自动化(selenium basic(,并希望仅此一项或通过一些适当的等待就可以实现

3( 更改IP和用户代理。如果你最初能够针对该页面运行XHR,那么现在你可能已经被该网站添加到可疑机器人的观察列表中。交替IP和用户代理不是我会做的事情。

最新更新