Разбор таблицы из IE в Excel

Question

Sub Web_Table_Option_Two()
Dim HTMLDoc As New HTMLDocument
Dim objTable As Object
Dim lRow As Long
Dim lngTable As Long
Dim lngRow As Long
Dim lngCol As Long
Dim ActRw As Long
Dim objIE As InternetExplorer
Set objIE = New InternetExplorer
objIE.navigate "https://finviz.com/screener.ashx?v=152"

Do Until objIE.readyState = 4 And Not objIE.Busy
    DoEvents
Loop
Application.Wait (Now + TimeValue("0:00:03")) 'wait for java script to load
HTMLDoc.body.innerHTML = objIE.document.body.innerHTML
With HTMLDoc.body
    Set objTable = .getElementsByTagName("table")
    For lngTable = 0 To objTable.Length - 1
        For lngRow = 0 To objTable(lngTable).Rows.Length - 1
            For lngCol = 0 To objTable(lngTable).Rows(lngRow).Cells.Length - 1
                ThisWorkbook.Sheets("Sheet1").Cells(ActRw + lngRow + 1, lngCol + 1) = objTable(lngTable).Rows(lngRow).Cells(lngCol).innerText
            Next lngCol
        Next lngRow
        ActRw = ActRw + objTable(lngTable).Rows.Length + 1
    Next lngTable
End With
objIE.Quit
End Sub

`

С помощью приведенного выше кода я пытаюсь получить данные Stock Screener с веб-сайта в коде, но таблица не помечена в HTML-коде, поэтому я не уверен, как ядолжен захватить эту информацию.В настоящее время он захватывает все на экране.

Answer 1

Только для информации нижней таблицы вы можете использовать следующее и нацелить на коллекцию тегов tbody и требуемый индекс внутри, чтобы избежать всего нежелательного пуха , который идет с выбором таблицы.

Я бы использовал запрос XMLHTTP как можно быстрее.Соответствующий индекс изменяется между двумя методами.

---

Запрос XMLHTTP:

Option Explicit
Public Sub GetTable()
    Dim sResponse As String, html As HTMLDocument, hTable As Object
    Set html = New HTMLDocument
    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", "https://finviz.com/screener.ashx?v=152", False
        .setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"
        .send
        sResponse = StrConv(.responseBody, vbUnicode)
    End With

    With html
        .body.innerHTML = sResponse
        Set hTable = .getElementsByTagName("tbody")(9)
        WriteTable hTable, 1, ThisWorkbook.Worksheets("Sheet1")
    End With
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
    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

---

Internet Explorer (с использованием подпрограммы WriteTable сверху):

Option Explicit
Public Sub GetInfo()
    Dim IE As New InternetExplorer, hTable As Object
    With IE
        .Visible = True
        .navigate "https://finviz.com/screener.ashx?v=152"

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

        Set hTable = .document.getElementsByTagName("tbody")(13)

        WriteTable hTable, 1, ThisWorkbook.Worksheets("Sheet1")
        .Quit
    End With
End Sub

---

Вывод:

---

Ссылки (VBE> Инструменты> Ссылки):

1. Microsoft Internet Controls
2. Библиотека объектов Microsoft HTML