使用VBA从Excel中的网页提取表

时间:2019-02-01 05:12:26

标签: html excel vba web-scraping

如何从网页中提取Excel中的下表?

公司|奖金比率|公告|记录|前奖金

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

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

通过保持奖金比率与网页或文本格式相同 在Excel中复制时,奖金比率转换为小数

1 个答案:

答案 0 :(得分:0)

您的hTable是一个集合,而不是单个元素。您的代码应该抛出错误。

您要定位到特定表,然后循环表中的行和行内的单元格。您要检查是否正在处理第二列,以便可以保护比率的格式。您还希望监视行号以处理顶部的合并单元格。

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