Question

试着问这个问题。没有得到很多答案。无法在我的工作计算机上安装内容。 https://stackoverflow.com/questions/29805065/vba-webscrape-not-picking-up-elements

想要使用以下代码将晨星页面扫描到Excel中。问题是，它不会反馈任何真实的元素/数据。我实际上只想从我放入my_Page的链接中获得红利和上限增值分配表。

这通常是最简单的方法，但是整个页面刮擦方式，和Excel - ＆gt;数据 - ＆gt;来自Web DON＆＃39; T工作。

我之前尝试过按标签名称和类使用get元素，但在这种情况下我无法做到这一点。这可能是要走的路......再一次，只想要那个红利和Cap Gain分配表。没有通过Debug.print看到任何结果

下面的工作代码，只需要解析为excel。下面更新了尝试：

Sub Macro1()


    Dim IE As New InternetExplorer
    IE.Visible = True
    IE.navigate "http://quotes.morningstar.com/fund/fundquote/f?&t=ANNPX&culture=en_us&platform=RET&viewId1=2046632524&viewId2=3141452350&viewId3=3475652630"
    Do
    DoEvents
    Loop Until IE.readyState = READYSTATE_COMPLETE
    Dim doc As HTMLDocument
    Set doc = IE.document



    'For Each Table In doc.getElementsByClassName("gr_table_b1")

    'For Each td In Table.getElementsByTagName("tr")
    On Error Resume Next
    For Each td In doc.getElementsByClassName("gr_table_row4")
    Debug.Print td.Cells(5).innerText
    'Debug.Print td.Cells(1).innerText
    Next td
    'Next Table


    'IE.Quit
         'Application.EnableEvents = True



  End Sub

Answer 1

相关内容包含在iframe中。您可以通过右键单击sebsite的该部分并选择Inspect element来查看此信息。查找树，您将看到一个包含数据网址的iframe标记。您应该尝试找到该元素，并提取该URL（使用js生成），然后打开该页面。

Answer 2

没有框架可担心。您只需要表ID。

网页视图：

从代码中打印出来：

VBA：

Option Explicit
Public Sub GetDivAndCapTable()
    Dim ie As New InternetExplorer, hTable As HTMLTable
    Const URL = "http://quotes.morningstar.com/fund/fundquote/f?&t=ANNPX&culture=en_us&platform=RET&viewId1=2046632524&viewId2=3141452350&viewId3=3475652630"
    Application.ScreenUpdating = False
    With ie
        .Visible = True

        .navigate URL

        While .Busy Or .READYSTATE < 4: DoEvents: Wend

        Set hTable = .document.getElementById("DividendAndCaptical")
        WriteTable hTable, 1
        Application.ScreenUpdating = True
        .Quit
    End With
End Sub

Public Sub WriteTable(ByVal hTable As HTMLTable, Optional ByVal startRow As Long = 1, Optional ByVal ws As Worksheet)

    If ws Is Nothing Then Set ws = ActiveSheet

    Dim tSection As Object, tRow As Object, tCell As Object, tr As Object, td As Object, R As Long, C As Long, tBody As Object
    R = startRow
    With ws
        Dim headers As Object, header As Object, columnCounter As Long
        Set headers = hTable.getElementsByTagName("th")
        For Each header In headers
            columnCounter = columnCounter + 1
            .Cells(startRow, columnCounter) = header.innerText
        Next header
        startRow = startRow + 1
        Set tBody = hTable.getElementsByTagName("tbody")
        For Each tSection In tBody               'HTMLTableSection
            Set tRow = tSection.getElementsByTagName("tr") 'HTMLTableRow
            For Each tr In tRow
                Set tCell = tr.getElementsByTagName("td")
                C = 1
                For Each td In tCell             'DispHTMLElementCollection
                    .Cells(R, C).Value = td.innerText 'HTMLTableCell
                    C = C + 1
                Next td
                R = R + 1
            Next tr
        Next tSection
    End With
End Sub

VBA Webscrape没有捡到精英;拿起相框/桌子？

2 个答案: