使用VBA從Web抓取資料時無法獲取確切的元素類表

我想從網站上抓取下表。 在此處輸入圖片說明

根據網路代碼，我發現該表似乎屬于元素類，etxtmed所以我在 VBA 下撰寫。運行此代碼后，我發現它只抓取下面的資料 在此處輸入影像描述

我認為這是因為("etxtmed")(0)參考了第一個("etxtmed")表然后我嘗試了幾個數字之后(0)VBA 首先報告"Element not exist"然后Run-time error '91':Object variable or With block variable not set在這行代碼處報告錯誤r = tbl.Rows.Length - 1。是不是因為我刮錯了表的類別？

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

uj5u.com熱心網友回復：

您想要的表在 IFRAME 內，因此您需要直接訪問該頁面 <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

標籤：html 擅长 vba 网页抓取

上一篇：在發送空""字串的公式周圍加上多少引號

下一篇：使用VB出現錯誤“未設定物件變數”