VBA抓取JavaScript渲染网页表格失败，求解决方案（香港渠务署）

问题根源 #

你的VBA代码失效主要有两个原因：

• 元素选择逻辑错误：目标表格的容器并非ncol-md-12 result，且tbody是table的子元素，你错误地用ul/li相关变量接收容器和tbody元素，导致遍历逻辑完全偏离目标。
• 未等待JS渲染完成：readyState = READYSTATE_COMPLETE仅表示页面静态资源加载完毕，而表格是JavaScript动态生成的，此时DOM中还不存在表格元素。

可行解决方案 #

方案一：改进IE自动化，等待动态元素渲染 #

通过延长等待时间确保JS完成表格渲染，同时修正元素选择逻辑，代码如下：

Sub DSD_IE_Fixed()
    Dim ie As New InternetExplorer
    Dim html As HTMLDocument
    Dim targetTable As HTMLTable
    Dim rowNum As Long, colNum As Integer
    
    ie.Visible = False
    ie.navigate "https://www.dsd.gov.hk/EN/Tender_Notices/Current_Tenders/index.html"
    
    ' 等待页面框架加载完成
    Do While ie.readyState <> READYSTATE_COMPLETE Or ie.Busy
        DoEvents
    Loop
    
    ' 额外等待JS渲染表格（可根据网络情况调整时长）
    Application.Wait Now + TimeValue("00:00:05")
    
    Set html = ie.document
    ' 定位目标表格（实际表格的class为table table-striped table-hover）
    Set targetTable = html.getElementsByClassName("table table-striped table-hover")(0)
    
    rowNum = 1
    ' 遍历表格行和列
    For Each tr In targetTable.Rows
        colNum = 1
        For Each td In tr.Cells
            Cells(rowNum, colNum).Value = td.innerText
            colNum = colNum + 1
        Next td
        rowNum = rowNum + 1
    Next tr
    
    ie.Quit
    Set ie = Nothing
End Sub

注意：需确保已引用Microsoft Internet Controls和Microsoft HTML Object Library（VBA编辑器→工具→引用）。

方案二：直接调用数据接口（更高效） #

该网站的表格数据通过AJAX从后端接口获取，直接请求接口解析JSON数据，无需启动浏览器，速度更快：

Sub DSD_API()
    Dim xhr As Object
    Dim jsonStr As String
    Dim jsonObj As Object
    Dim rows As Variant, row As Variant
    Dim rowNum As Long, colNum As Integer
    
    Set xhr = CreateObject("MSXML2.XMLHTTP")
    ' 数据接口地址（通过抓包获取）
    xhr.Open "GET", "https://www.dsd.gov.hk/EN/Tender_Notices/Current_Tenders/data.json", False
    xhr.send
    
    jsonStr = xhr.responseText
    ' 解析JSON（需导入VBA-JSON模块，可在VBA编辑器插入模块后粘贴对应代码）
    Set jsonObj = JsonConverter.ParseJson(jsonStr)
    
    rowNum = 1
    ' 写入表头
    Cells(rowNum, 1) = "Tender No."
    Cells(rowNum, 2) = "Description"
    Cells(rowNum, 3) = "Closing Date/Time"
    Cells(rowNum, 4) = "Download"
    rowNum = rowNum + 1
    
    ' 遍历数据行
    For Each row In jsonObj("data")
        Cells(rowNum, 1) = row("tenderNo")
        Cells(rowNum, 2) = row("title")
        Cells(rowNum, 3) = row("closingDt")
        Cells(rowNum, 4) = row("downloadUrl")
        rowNum = rowNum + 1
    Next row
    
    Set xhr = Nothing
    Set jsonObj = Nothing
End Sub

注意：使用此方案需先导入VBA JSON解析模块（可获取VBA-JSON代码插入到VBA模块中）。

内容的提问来源于stack exchange，提问作者Ray Tse