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
我正在尝试从网页获取 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