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:
References (VBE > Tools > References):
- Microsoft Internet Controls
- Microsoft HTML Object Library
Tags: excelexcel, vba
