Extract Table from Webpage in Excel using VBA

Question

How to Extract Below table in Excel from Webpage?

Table

Company | Bonus Ratio |Announcement|Record|Ex-Bonus

Codes
Dim ie As SHDocVw.InternetExplorer
Set ie = New InternetExplorerMedium
Set ie = CreateObject("InternetExplorer.Application")
 While ie.busy
 DoEvents
 Wend
 ie.Visible = True
 While ie.busy
 DoEvents
 Wend
Dim NavURL As String
NavURL = "https://www.moneycontrol.com/stocks/marketinfo/bonus/homebody.php?sel_year=2015"

ie.Navigate NavURL
 While ie.busy
 DoEvents
 Wend
 Set doc = ie.document
 Set hTable = doc.GetElementsByTagName("table")


 y = 2 'Column B in Excel
 z = 7 'Row 7 in Excel
 For Each td In hTable
 Set hHead = tb.GetElementsByTagName("td")
 For Each hh In hHead
 Set hTR = hh.GetElementsByTagName("tr")
 For Each tr In hTR

Webpage: https://www.moneycontrol.com/stocks/marketinfo/bonus/homebody.php?sel_year=2015

by Keeping Bonus Ratio as Same as on Webpage or Text Format While copy it in Excel, Bonus Ratio Converts to Decimal

Please edit the question and show the code you use to copy the table from the webpage to the worksheet. — omegastripes, Feb 01 '19 at 06:34
Your code is incomplete. Can you also show a screenshot of the current outpout of that macro? — Pᴇʜ, Feb 01 '19 at 08:40
i don't know the codes in depth..i don't know the detail VBA/HTML? Help me if you can — Ashish, Feb 01 '19 at 08:50

score 0 · Accepted Answer · answered Feb 01 '19 at 09:28

Your hTable is a collection as opposed to a single element. Your code should be throwing an error.

You want to target the specific table and then loop the table rows and cells within rows. You want to check if the second column is being processed so you can protect the formatting of the ratios. You also want to monitor the row number to handle the merged cells at the top.

Option Explicit
Public Sub GetInfo()
    Const URL As String = "https://www.moneycontrol.com/stocks/marketinfo/bonus/homebody.php?sel_year=2015"
    Dim html As HTMLDocument, hTable As HTMLTable, ws As Worksheet, headers()
    headers = Array("Company", "Bonus Ratio", "Announcement", "Record", "Ex-bonus")
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    Set html = New HTMLDocument
    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", URL, False
        .Send
        html.body.innerHTML = .responseText
    End With
    Set hTable = html.querySelector("table.dvdtbl")
    Dim td As Object, tr As Object, r As Long, c As Long
    r = 1
    With ws
        .Cells(1, 1).Resize(1, UBound(headers) + 1) = headers
        For Each tr In hTable.getElementsByTagName("tr")
            r = r + 1: c = 1
            If r > 3 Then
                For Each td In tr.getElementsByTagName("td")
                    .Cells(r - 2, c) = IIf(c = 2, "'" & td.innerText, td.innerText)
                    c = c + 1
                Next
            End If
        Next
    End With
End Sub

Extract Table from Webpage in Excel using VBA

1 Answers1

Linked