Я пытаюсь получить денежные потоки для группы компаний в папке, которую я создал.Я извлекаю информацию из обзора рынка.Примером веб-сайтов, с которых я беру таблицы, является https://www.marketwatch.com/investing/stock/aapl/financials/cash-flow. Все символы тикера для каждой компании находятся в столбце А. В следующей строке мой код содержит ошибку «Ошибка времени выполнения» 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
Iиспользовал приведенный выше код, а затем я использовал приведенный ниже открытый код (где возникает проблема), чтобы получить таблицу.
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