需要帮助从HTML获取表格吗

需要帮助从HTML获取表格吗,html,excel,vba,web-scraping,Html,Excel,Vba,Web Scraping,我一直在使用以下代码成功地从Marketwatch.com获取共同基金业绩数据: Dim A As Long Dim B As Long Dim C As Long Dim Z As Long For Z = 1 To 35 Range("A1").Select ActiveCell.Offset((37 + (Z * 10)), 0).Select If ActiveCell.Value = "" Then Exit For Else En

我一直在使用以下代码成功地从Marketwatch.com获取共同基金业绩数据:

Dim A As Long
Dim B As Long
Dim C As Long
Dim Z As Long


For Z = 1 To 35

    Range("A1").Select
    ActiveCell.Offset((37 + (Z * 10)), 0).Select
    If ActiveCell.Value = "" Then
    Exit For
    Else
    End If
Dim oHTML       As Object
Dim oTable      As Object
Dim x           As Long
Dim Y           As Long
Dim vData       As Variant

Set oHTML = CreateObject("HTMLFile")

With CreateObject("WinHTTP.WinHTTPRequest.5.1")
.Open "GET", "http://www.marketwatch.com/investing/fund/vfinx", False
.send
oHTML.body.innerhtml = .responsetext
End With

For Each oTable In oHTML.Getelementsbytagname("table")
If oTable.classname = "fundstable" Then
    ReDim vData(1 To oTable.Rows.Length, 1 To oTable.Rows(1).Cells.Length)

        For x = 1 To UBound(vData)
        For Y = 1 To UBound(vData, 2)
            vData(x, Y) = oTable.Rows(x - 1).Cells(Y - 1).innertext
        Next Y
        Next x

    With ActiveCell.Offset(1, 0)
    .Resize(UBound(vData), UBound(vData, 2)).Value = vData
    End With
Exit For
End If
Next oTable

Next Z
不幸的是,Marketwatch添加了一个验证码来阻止机器人(即我)抓取他们的数据。我不知道这是怎么回事,所以我想我应该试试另一个网站

我看着晨星:

我希望在该页面上显示的表格可能是:“table.r_table3 width955px print97”或“r_table3 width955px print97”,但这两个表格似乎都不适合我

有什么想法吗


谢谢

数据由javascript加载,无法通过XMLHTTP请求获得,因为脚本不必运行来加载内容

例如,您可以在IE中使用第二个链接,并引入等待以确保加载信息。我将展示如何在索引1处获取具有该类名的表。您可以在此处更改索引:

ele.item(1).outerHTML
因此,对于下一个表,请使用
clipboard.SetText ele.item(2).outerHTML

您还可以循环
ele
.Length
,以获取每个表,但请确保在粘贴时写入不同的单元格:

Dim i As Long
For i = 0 To ele.Length-1
    clipboard.SetText  ele.item(i).outerHTML
   'Etc   
Next

VBA:

选项显式
公共子GetInfo()
Dim IE作为新的InternetExplorer,剪贴板作为对象
Dim ele作为对象,ws作为工作表,t作为日期,tableCount作为长
常量最大等待时间=5秒
设置ws=ThisWorkbook.Worksheets(“Sheet1”)
设置剪贴板=GetObject(“新建:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}”)
与IE
.Visible=True
.导航“http://performance.morningstar.com/fund/performance-return.action?t=VFINX®ion=usa&culture=en_US"
当.Busy或.readyState<4:DoEvents:Wend时
随附.文件
t=计时器
做
多芬特
出错时继续下一步
Set ele=.queryselectoral(“.r\u table3.print97”)
tableCount=元素长度
错误转到0
如果定时器-t>最大等待时间,则退出Do
在tableCount<3时循环
如果不是,那么ele什么都不是
clipboard.SetText ele.item(1).outerHTML
剪贴板.PutInClipboard
ws.Cells(1,1).PasteSpecial
如果结束
以
退出
以
端接头


好的-很好-谢谢!但我真的想要下一张桌子。因此,我将“.r_table3.print97”更改为“.r_table3.width955px.print97”,并开始出现运行时错误“424”:需要对象。请原谅我的新手问题,但我认为我们已经声明了那个对象,所以我不理解为什么切换表会导致这个错误。再次感谢你的帮助!使用clipboard.SetText ele.item(2).outerHTML替代clipboard.SetText ele.item(1).outerHTML?(如果是这样,那对我不起作用)仍然得到相同的424错误。如果你可以得到表1,那么你应该能够得到下一个。在失败行之前插入debug.print ele.length。然后按Ctrl+G键检查打印的值。另外,请检查您的代码是否与上面我的链接中的代码相同。你也可以增加Const MAX_WAIT_SEC,只要=10就行了!非常感谢你!!还有一个问题——有没有办法不用打开窗户就可以做到?i、 只是在后台工作。。。我计划将此代码添加到其他代码中,以便在许多基金上使用该表,并且不希望每次都有新的窗口打开。再次感谢!
Option Explicit

Public Sub GetInfo()
    Dim IE As New InternetExplorer, clipboard As Object
    Dim ele As Object, ws As Worksheet, t As Date, tableCount As Long
    Const MAX_WAIT_SEC As Long = 5
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    Set clipboard = GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")

    With IE
        .Visible = True
        .navigate "http://performance.morningstar.com/fund/performance-return.action?t=VFINX&region=usa&culture=en_US"

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

        With .document
            t = Timer
            Do
                DoEvents
                On Error Resume Next
                Set ele = .querySelectorAll(".r_table3.print97")
                tableCount = ele.Length
                On Error GoTo 0
                If Timer - t > MAX_WAIT_SEC Then Exit Do
            Loop While tableCount < 3

            If Not ele Is Nothing Then
                clipboard.SetText ele.item(1).outerHTML
                clipboard.PutInClipboard
                ws.Cells(1, 1).PasteSpecial
            End If
        End With
        .Quit
    End With
End Sub