Jacob45678
New Member
- Joined
- Sep 17, 2022
- Messages
- 10
- Office Version
- 2019
- Platform
- Windows
Hi, I want to web scrape information to an excel worksheet for multiple pages. example from page 1 to 3. Below is my code, but im having some issue's (error type mismatch). Any help is much appreciated. Thanks in advance.
The Page: https://www.nasdaq.com/market-activity/stocks/screener
Example of how the scrapped data from multiple pages will be in excel:
My code with error
Option Explicit
Public Sub GetRates()
Dim html As HTMLDocument, hTable As HTMLTable '<== Tools > References > Microsoft HTML Object Library
Set html = New HTMLDocument
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", "https://www.nasdaq.com/market-activity/stocks/screener", False
.setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT" 'to deal with potential caching
.send
html.body.innerHTML = .responseText
End With
Application.ScreenUpdating = False
'Set hTable = html.getElementById("nasdaq-screener__table-container")
Set hTable = html.getElementsByClassName("nasdaq-screener__table-container") 'get table id from element
WriteTable hTable, 1, ThisWorkbook.Worksheets("Sheet1")
Application.ScreenUpdating = True
End Sub
Public Sub WriteTable(ByVal hTable As HTMLTable, Optional ByVal startRow As Long = 1, Optional ByVal ws As Worksheet)
Dim tSection As Object, tRow As Object, tCell As Object, tr As Object, td As Object, r As Long, C As Long, tBody As Object
r = startRow: If ws Is Nothing Then Set ws = ActiveSheet
With ws
Dim headers As Object, header As Object, columnCounter As Long
Set headers = hTable.getElementsByTagName("th")
For Each header In headers
columnCounter = columnCounter + 1
Select Case columnCounter
Case 2
.Cells(startRow, 1) = header.innerText 'header/title position
Case 3
.Cells(startRow, 2) = header.innerText 'header/title position
Case 8
.Cells(startRow, 3) = header.innerText 'header/title position
End Select
Next header
startRow = startRow + 1
Set tBody = hTable.getElementsByTagName("tbody") 'body containing all data
For Each tSection In tBody
Set tRow = tSection.getElementsByTagName("tr") 'each row in body
For Each tr In tRow
r = r + 1
Set tCell = tr.getElementsByTagName("td") 'each data in row
C = 1
For Each td In tCell
Select Case C
Case 2
.Cells(r, 1).Value = td.innerText
Case 3
.Cells(r, 2) = td.innerText
Case 8
.Cells(r, 3).Value = td.innerText
End Select
C = C + 1
Next td
Next tr
Next tSection
End With
End Sub
The Page: https://www.nasdaq.com/market-activity/stocks/screener
Example of how the scrapped data from multiple pages will be in excel:
My code with error
Option Explicit
Public Sub GetRates()
Dim html As HTMLDocument, hTable As HTMLTable '<== Tools > References > Microsoft HTML Object Library
Set html = New HTMLDocument
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", "https://www.nasdaq.com/market-activity/stocks/screener", False
.setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT" 'to deal with potential caching
.send
html.body.innerHTML = .responseText
End With
Application.ScreenUpdating = False
'Set hTable = html.getElementById("nasdaq-screener__table-container")
Set hTable = html.getElementsByClassName("nasdaq-screener__table-container") 'get table id from element
WriteTable hTable, 1, ThisWorkbook.Worksheets("Sheet1")
Application.ScreenUpdating = True
End Sub
Public Sub WriteTable(ByVal hTable As HTMLTable, Optional ByVal startRow As Long = 1, Optional ByVal ws As Worksheet)
Dim tSection As Object, tRow As Object, tCell As Object, tr As Object, td As Object, r As Long, C As Long, tBody As Object
r = startRow: If ws Is Nothing Then Set ws = ActiveSheet
With ws
Dim headers As Object, header As Object, columnCounter As Long
Set headers = hTable.getElementsByTagName("th")
For Each header In headers
columnCounter = columnCounter + 1
Select Case columnCounter
Case 2
.Cells(startRow, 1) = header.innerText 'header/title position
Case 3
.Cells(startRow, 2) = header.innerText 'header/title position
Case 8
.Cells(startRow, 3) = header.innerText 'header/title position
End Select
Next header
startRow = startRow + 1
Set tBody = hTable.getElementsByTagName("tbody") 'body containing all data
For Each tSection In tBody
Set tRow = tSection.getElementsByTagName("tr") 'each row in body
For Each tr In tRow
r = r + 1
Set tCell = tr.getElementsByTagName("td") 'each data in row
C = 1
For Each td In tCell
Select Case C
Case 2
.Cells(r, 1).Value = td.innerText
Case 3
.Cells(r, 2) = td.innerText
Case 8
.Cells(r, 3).Value = td.innerText
End Select
C = C + 1
Next td
Next tr
Next tSection
End With
End Sub