Home » excel » vba – Parse Table from IE to Excel

vba – Parse Table from IE to Excel

Posted by: admin May 14, 2020 Leave a comment

Questions:
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

`

With the code above I am trying to get the Stock Screener data from the website in the code but the table isn’t labeled in HTML code so I am not sure how I am supposed to grab this info. Currently it is grabbing everything on the screen.

How to&Answers:

For just the bottom table info you can use the following and target the tbody tag collection, and the required index within, to avoid all the unwanted fluff that comes with table selection.

I would use XMLHTTP request as faster. The appropriate index changes between the two methods.


XMLHTTP request:

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 (using WriteTable sub from above):

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

Output:

enter image description here


References (VBE > Tools > References):

  1. Microsoft Internet Controls
  2. Microsoft HTML Object Library