vbaweb-scrapingmsxml

Vba code to get table from webpage to excel

I am trying to get table from webpage to excel but no result and also i am not getting any error message.Below is the code which i have try.

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

I want to get table as shown in below pic

enter image description here

Solution

  • Where did you get an idea to use getElementsByTagName("table"), while there is no single table tag on this page? It's all DIVs.

    I operate on HTMLDocument which requires reference to Microsoft HTML Object Library, Set html = CreateObject("htmlfile") gave me an object which didn't allow getElementsByClassName.

    I removed all (now) redundant variable declarations.

    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