Home > Software design >  Unable to get the exact element class table when scraping data from web using VBA
Unable to get the exact element class table when scraping data from web using VBA

Time:12-18

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&amp;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
  • Related