I would like to scrape below table from the website. enter image description here
Based on the web code I found that the table seemed belongs to element class etxtmed
so I wrote below VBA. After running this code I found that it only scrape below data
enter image description here
I thought this was because ("etxtmed")(0)
refers to the 1st ("etxtmed")
table then I tried several numbers after (0)
and VBA first reports "Element not exist"
then reports error Run-time error '91':Object variable or With block variable not set
at this line of code r = tbl.Rows.Length - 1
. Is it because I scraped the wrong class of table?
Sub CopyRateFromHKAB()
Dim ie As Object, btnmore As Object, tbl As Object
Dim rr As Object, cc As Object, r As Integer, c As Integer, i As Integer, j As Integer
ThisWorkbook.Sheets("Sheet2").UsedRange.Clear
Set ie = CreateObject("internetexplorer.application")
With ie
'.Visible = True
.navigate "https://www.hkab.org.hk/DisplayInterestSettlementRatesAction.do?lang=en"
Do
DoEvents
Loop While .readyState <> 4 Or .Busy
Set tbl = .document.getElementsByClassName("etxtmed")(0)
If tbl Is Nothing Then
MsgBox "Element not exist"
End If
End With
'get data from table
r = tbl.Rows.Length - 1
c = tbl.Rows(0).Cells.Length - 1
ReDim arr(0 To r, 0 To c)
Set rr = tbl.Rows
For i = 0 To r
Set cc = rr(i).Cells
For j = 0 To c
arr(i, j) = cc(j).innertext
Next
Next
ie.Quit
Application.ScreenUpdating = False
ThisWorkbook.Sheets("Sheet2").Cells(1, 1).Resize(r 1, c 1) = arr
With ThisWorkbook.Sheets("Sheet2")
.UsedRange.WrapText = False
.Columns.AutoFit
End With
End Sub
CodePudding user response:
The table you want is inside an IFRAME so you need to access that page directly <iframe src="/hibor/listRates.do?lang=en&Submit=Detail"
Option Explicit
Sub CopyRateFromHKAB()
Const URL = "https://www.hkab.org.hk/hibor/listRates.do?lang=en&Submit=Detail"
Dim HTMLDoc As Object, request As Object
' get web page
Set HTMLDoc = CreateObject("HTMLfile")
Set request = CreateObject("MSXML2.XMLHTTP")
With request
.Open "GET", URL, False
.send
HTMLDoc.body.innerHTML = .responseText
End With
' parse html table
Dim wb As Workbook, r As Long, c As Long, arr
Dim tbl As Object, t As Object, tr As Object, td As Object
Set wb = ThisWorkbook
Set tbl = HTMLDoc.getElementsByClassName("etxtmed")
If tbl Is Nothing Then
MsgBox "No tables found", vbExclamation
Exit Sub
Else
If tbl(2) Is Nothing Then
MsgBox "Table not found", vbExclamation
Exit Sub
Else
r = tbl(2).Rows.Length
ReDim arr(1 To r, 1 To 3)
r = 1
For Each tr In tbl(2).Rows
c = 1
For Each td In tr.Cells
arr(r, c) = td.innerText
c = c 1
Next
r = r 1
Next
End If
'copy to sheet
With wb.Sheets("Sheet2")
.Cells(1, 1).Resize(UBound(arr), UBound(arr, 2)) = arr
.UsedRange.WrapText = False
.Columns.AutoFit
End With
End If
MsgBox "Done", vbInformation
End Sub