невозможно получить конкретную таблицу с веб-страницы, используйте код для работы

Question

У меня был некоторый код в Excel VBA, который соткал сотни страниц, извлекая все ячейки из таблицы, называемой «Инсайдерские транзакции» по определенным URL-адресам.Ниже приведен пример URL: https://www.gurufocus.com/stock/HIL/insider

По какой-то причине мой код ниже больше не работает.Я не могу на всю жизнь понять, почему.Класс, который я пытаюсь получить, по-прежнему называется «таблица данных обычной таблицы»

Я попытался избавиться от (0), поскольку, как представляется, существует только одна таблица с именем класса normal-table data-table now.

Установить код:

Set allCells = doc.body.getElementsByClassName("normal-table data-table")(0).getElementsByTagName("td")

при запуске текущего кода сообщения об ошибках не выдаются, но ясно, что для allCells ничего не задано, посколькумой код не работает и allCells.length ничего не возвращает.Спасибо

Answer 1

XMLHTTP:

Быстрее, чем браузер и предоставление дополнительной информации xhr.

Данные предоставляются из вызова API. Вы можете очистить токен для этого и передать следующий запрос. Несколько вспомогательных функций для получения токена и обработки результатов, а также анализатор json для обработки ответа json от API.

Для этого требуется установить код для jsonparser из jsonconverter.bas в стандартный модуль с именем JsonConverter, а затем перейти к VBE> Инструменты> Ссылки> Добавить ссылку на Microsoft Scripting Runtime.

Option Explicit

Public Sub GetInfo()
    Dim json As Object, headers(), ws As Worksheet, i As Long, results()
    Dim re As Object, r As Long, c As Long, dict As Object, p As String, token As String, s As String

    Set ws = ThisWorkbook.Worksheets("Sheet1")
    p = "password_grant_custom\.client"":""(.*?)"""
    Set re = CreateObject("VBScript.RegExp")

    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", "https://www.gurufocus.com/stock/HIL/insider", False
        .send
        token = GetToken(re, .responseText, p)
        If token = "Not found" Then Exit Sub
        .Open "GET", "https://www.gurufocus.com/reader/_api/stocks/NYSE:HIL/insider?page=1&per_page=1000&sort=date%7Cdesc", False
        .setRequestHeader "authorization", "Bearer " & token
        .send
        s = .responseText
        Set json = JsonConverter.ParseJson(.responseText)("data")
        headers = json(1).keys
        ReDim results(1 To json.Count, 1 To UBound(headers) + 1)
        For Each dict In json
            r = r + 1: c = 1
            For i = LBound(headers) To UBound(headers)
                If headers(i) <> "ownership_details" Then
                    results(r, c) = dict(headers(i))
                Else
                    results(r, c) = EmptyDict(dict(headers(i)))
                End If
                c = c + 1
            Next
        Next
    End With
    With ws
        .Cells(1, 1).Resize(1, UBound(headers) + 1) = headers
        .Cells(2, 1).Resize(UBound(results, 1), UBound(results, 2)) = results
    End With
End Sub

Public Function EmptyDict(ByVal dict As Object, Optional r As String, Optional key As Variant) As String
    Dim s As String
    For Each key In dict
        If TypeName(dict(key)) = "Dictionary" Then
            r = EmptyDict(dict(key), r, key)
        Else
            s = IIf(key = "D", "Direct ", key)
            r = r & s & " " & dict(key) & Chr$(10)
        End If
    Next
    EmptyDict = r
End Function

Public Function GetToken(ByVal re As Object, ByVal inputString As String, ByVal pattern As String) As String
    With re
        .Global = True
        .pattern = pattern
        If .test(inputString) Then               ' returns True if the regex pattern can be matched agaist the provided string
            GetToken = .Execute(inputString)(0).SubMatches(0)
        Else
            GetToken = "Not found"
        End If
    End With
End Function

---

Пример вывода:

---

Использование браузера, а также установка результатов на 100 на странице:

Следующее сообщение не отображается, если оно есть.

Option Explicit
Public Sub GetData()
    Dim ie As Object, clipboard As Object, ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    Set clipboard = GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
    Set ie = CreateObject("InternetExplorer.Application")
    With ie
        .Visible = True
        .Navigate2 "https://www.gurufocus.com/stock/HIL/insider"

        While .Busy Or .readyState < 4: DoEvents: Wend
        With .document
            If .querySelectorAll(".login-card").Length > 0 Then
                .querySelector(".login-card .el-icon-close").Click
            End If
            .querySelector(".el-icon-caret-bottom").Click
            .querySelector(".aio-popover-item:nth-of-type(6)").Click
        End With
        While .Busy Or .readyState < 4: DoEvents: Wend

        clipboard.SetText .document.querySelector(".data-table").outerHTML
        clipboard.PutInClipboard
        ws.Range("A1").PasteSpecial
        .Quit
    End With
End Sub

Answer 2

Попробуйте

window.addEventListener('load', () => {
  let data = document.body.getElementsByClassName("normal-table data-table")[0].getElementsByTagName("td");
  // do something with data
})

Вместо круглых '(' скобок это выглядит нормально. Но, возможно, что данные в таблице загружаются после выполнения вашей функции, поэтому ошибка ее выдачи.

Вы можете обратиться к этому сообщению