Vba 从网页获取 table 到 excel 的代码

Vba code to get table from webpage to excel

我正在尝试从网页获取 table 到 excel 但没有结果,而且我也没有收到任何错误 message.Below 是我尝试过的代码。

Sub Web_Table_Option_One()
Dim xml    As Object
Dim html   As Object
Dim objTable As Object
Dim result As String
Dim lRow As Long
Dim lngTable As Long
Dim lngRow As Long
Dim lngCol As Long
Dim ActRw As Long
Set xml = CreateObject("MSXML2.XMLHTTP.6.0")
With xml
.Open "GET", "https://www.99acres.com/microsite/ambey-group-eco-valley-new-town-kolkata-east/", False
.Send
End With
result = xml.responseText
Set html = CreateObject("htmlfile")
html.body.innerHTML = result
Set objTable = html.getElementsByTagName("table")
 For lngTable = 0 To objTable.Length - 1
        For lngRow = 0 To objTable(lngTable).Rows.Length - 1
            For lngCol = 0 To objTable(lngTable).Rows(lngRow).Cells.Length - 1
                ThisWorkbook.Sheets("Sheet3").Cells(ActRw + lngRow + 1, lngCol + 1) = objTable(lngTable).Rows(lngRow).Cells(lngCol).innerText
            Next lngCol
        Next lngRow
        ActRw = ActRw + objTable(lngTable).Rows.Length + 1
    Next lngTable
End Sub

我想要table如下图所示

虽然此页面上没有单个 table 标记,但您是从哪里想到使用 getElementsByTagName("table") 的?都是DIV。

我在 HTMLDocument 上操作需要参考 Microsoft HTML 对象库,Set html = CreateObject("htmlfile") 给了我一个不允许 getElementsByClassName.[=16= 的对象]

我删除了所有(现在)多余的变量声明。

Option Explicit

Sub Web_Table_Option_One()

    Dim xml As Object
    Dim html As New HTMLDocument
    Dim myTable As HTMLObjectElement
    Dim result As String
    Dim rowNum As Long
    Dim colNum As Long      

    Set xml = CreateObject("MSXML2.XMLHTTP.6.0")

    With xml
        .Open "GET", "https://www.99acres.com/microsite/ambey-group-eco-valley-new-town-kolkata-east/", False
        .Send
    End With

    result = xml.responseText

    html.body.innerHTML = result
    Set myTable = html.getElementsByClassName("divTableBody")(0)

    With ThisWorkbook.Sheets("Sheet3")
        For rowNum = 0 To myTable.Children.Length - 1
            For colNum = 0 To myTable.Children(rowNum).Children.Length - 1
                .Cells(rowNum + 1, colNum + 1) = myTable.Children(rowNum).Children(colNum).innerText
            Next colNum
        Next rowNum
    End With

End Sub

您找错了标签名称。但是,以下方法可以从该页面获取表格数据:

Sub FetchTable()
    Dim HTTP As New XMLHTTP60, HTML As New HTMLDocument
    Dim trow As HTMLDivElement, tcel As HTMLDivElement, R&, C&

    With HTTP
        .Open "GET", "https://www.99acres.com/microsite/ambey-group-eco-valley-new-town-kolkata-east/", False
        .send
        HTML.body.innerHTML = .responseText
    End With

    For Each trow In HTML.getElementsByClassName("divTableBody")(0).Children
        For Each tcel In trow.getElementsByClassName("divTableCell")
            C = C + 1: Cells(R + 1, C) = tcel.innerText
        Next tcel
        C = 0: R = R + 1
    Next trow
End Sub