网页抓取 vba答案

【问题标题】：Webscraping vba网页抓取 vba
【发布时间】：2015-09-17 11:16:53
【问题描述】：

我正在尝试从彭博网站上抓取一些信息，无需订阅。网址是：http://www.bloomberg.com/quote/BCOMTR:IND。代码运行完美，没有错误，但是我试图将内部文本粘贴到的单元格仍然是空白的。知道为什么我无法检索它吗？

这是我的代码：

Dim TDelements As Object
Dim TDelement As Object

Set oIE = CreateObject("InternetExplorer.Application")
sURL = "http://www.bloomberg.com/quote/BCOMTR:IND"

With oIE
    .Navigate sURL
    .Visible = True

    Do While oIE.Busy: DoEvents: Loop
    Do While oIE.ReadyState <> 4: DoEvents: Loop

    Sheets("Sheet1").Activate
    Range("A5").Select

    Set Iedoc = oIE.document
    For i = 0 To Iedoc.all.Length - 1

        Set TDelements = Iedoc.getElementsByClassName("cell__value cell__value")
        ' loop thru each row in our table
        ' note we skip the first (header) row below ...
        For Each TDelement In TDelements
            If TDelement.className = ("cell__value cell__value") Then
                ActiveCell.Value = TDelement(3).innerText
            End If
        Next
        Exit For
    Next i
End With
End Sub

【问题讨论】：

您是否尝试过任何调试？例如，您如何知道您的代码正在进入每个循环？您是否需要在 If 块中添加另一个 Exit For 语句？
你也在迭代一个对象集合，通过寻找一个类名来设置 - 然后测试它们是否具有与它们被收集时相同的类名......跨度>

标签： vba web-scraping

【解决方案1】：

找到我的答案！

    Dim htmCol As HTMLElementCollection

Set doc = New HTMLDocument
With CreateObject("MSXML2.XMLHTTP")
    .Open "GET", "http://www.bloomberg.com/quote/BCOMTR:IND" & Code
    .send
    Do: DoEvents: Loop Until .readyState = 4
    doc.body.innerHTML = .responseText
    .abort
End With

Set htmCol = doc.getElementsByClassName("cell__value cell__value")(2)

Sheets("Sheet1").Activate
Range("A5").Select

ActiveCell.Value = htmCol.innerText

结束子

【讨论】：