CODEWITHSUNDEEP
htmlexcelvbaweb-scraping
Sun Guochen
Sun Guochen

Reputation: 29

Unable to get the exact element class table when scraping data from web using VBA

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

Upvotes: 0

Views: 146

Answers (1)

CDP1802
CDP1802

Reputation: 16184

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

Upvotes: 1

Related Questions