Table Scraping through Excel VBA

Question

Trying to Extract the Table from the web and i have managed to copy and paste the table on Excel Sheet. But the problem is it includes further data of Web Page which i do not want to have.

How to paste the only table on Sheet excluding any further data. I hope someone can explain this better.

 Sub Web_Table()

    Dim HTMLDoc As New HTMLDocument
    Dim objTable As Object
    Dim lRow As Long
    Dim lngTable As Long
    Dim lngRow As Long
    Dim lngCol As Long
    Dim ActRw As Long
    
    Dim objIE As InternetExplorer
    Set objIE = New InternetExplorer
    
    objIE.Navigate "https://www.eia.gov/dnav/pet/hist/LeafHandler.ashx?n=PET&s=EMD_EPD2DXL0_PTE_NUS_DPG&f=W"

    Do Until objIE.ReadyState = 4 And Not objIE.Busy
        DoEvents
    Loop
    
    Application.Wait (Now + TimeValue("0:00:03")) 'wait for java script to load
    HTMLDoc.body.innerHTML = objIE.Document.body.innerHTML
    
    With HTMLDoc.body
    
        Set objTable = .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("Sheet1").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 With
    objIE.Quit
End Sub

Raymond Wu · Accepted Answer · 2021-08-16 15:09:35Z

1

I'm not exactly sure which table do you want to keep but assuming that you want the 8th table only (since it has lots of rows) then you can simply refer to it by its index 7 (as it is base 0).

getElementsByTagName method returns a collection of elements (even if it has only 1 result) but you can narrow it to a specific element by its index.

Modify your code to below:

    With HTMLDoc.body
    
        Set objTable = .getElementsByTagName("table")(7) 'Return only the 8th table from the collection
            For lngRow = 0 To objTable.Rows.Length - 1
                For lngCol = 0 To objTable.Rows(lngRow).Cells.Length - 1
                    ThisWorkbook.Sheets("Sheet1").Cells(ActRw + lngRow + 1, lngCol + 1) = objTable.Rows(lngRow).Cells(lngCol).innerText
                Next lngCol
            Next lngRow
                    
    End With

answered Aug 16, 2021 at 15:09

Raymond Wu

3,4272 gold badges9 silver badges20 bronze badges

Sign up to request clarification or add additional context in comments.

1 Comment

Rajput Over a year ago

That's great to have the code. So i was not aware that i need to follow the HTML tags to get the data. Thanks

QHarr · Accepted Answer · 2021-08-17 05:21:46Z

1

The large table can be selected by its class (the id is not present in without JavaScript rendering) using faster xhr request. You can then simply use the clipboard to transfer the table to Excel sheet:

Option Explicit

Public Sub WriteOutTable()
    'required VBE (Alt+F11) > Tools > References > Microsoft HTML Object Library ;  Microsoft XML, v6 (your version may vary)

    Dim hTable As MSHTML.HTMLTable, clipboard As Object
    Dim xhr As MSXML2.XMLHTTP60, html As MSHTML.HTMLDocument
   
    Set xhr = New MSXML2.XMLHTTP60
    Set html = New MSHTML.HTMLDocument

    With xhr
        .Open "GET", "https://www.eia.gov/dnav/pet/hist/LeafHandler.ashx?n=PET&s=EMD_EPD2DXL0_PTE_NUS_DPG&f=W", False
        .send
        html.body.innerHTML = .responseText
    End With

    Set hTable = html.querySelector(".FloatTitle")
    Set clipboard = GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
    clipboard.SetText hTable.outerHTML
    clipboard.PutInClipboard
    ThisWorkbook.Worksheets("Sheet1").Cells(1, 1).PasteSpecial
    
End Sub

edited Aug 17, 2021 at 5:21

answered Aug 16, 2021 at 21:27

QHarr

84.5k14 gold badges58 silver badges105 bronze badges

4 Comments

Rajput Over a year ago

I tested the code and its result was speedy as you said. But after clearing the contents of the table from the excel when i run it again then it returns the header not all data. what can be the reason?

Rajput Over a year ago

I have added some code which creates the new sheet and deletes the old with same name. Then code works fine and data paste accordingly. But it does not paste updated data again on same sheet.

QHarr Over a year ago

See my edit. I changed code to write to sheet1 rather than ActiveSheet.

Rajput Over a year ago

Its seems great @QHarr Thanks buddy

Collectives™ on Stack Overflow

Table Scraping through Excel VBA

2 Answers 2

1 Comment

4 Comments

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

2 Answers 2

1 Comment

4 Comments

Your Answer

Sign up or log in

Post as a guest

Related