Webscraping vba

时间:2015-06-30 15:08:21

标签: vba web-scraping

我试图从bloomberg网站上删除一些信息,不需要订阅。网址为:http://www.bloomberg.com/quote/BCOMTR:IND。代码运行完美,没有错误,但是我试图将我的innertext粘贴到的单元格仍为空白。知道为什么我无法找回它吗?

这是我的代码:

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

1 个答案:

答案 0 :(得分:0)

找到我的答案!

    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

End Sub