使用getElementById VBA网站抓取

时间:2019-02-04 02:50:12

标签: excel vba

以下宏可以很好地使用getElementsByClassName从某个范围的网页中提取数据,但是由于类名不是唯一的,因此我需要将其更改为getElementsById。这里的任何帮助将不胜感激

Dim oHtml As HTMLDocument
Dim oElement As Object
Dim url As String
Set oHtml = New HTMLDocument

Application.ScreenUpdating = False

Sheets("ASIN").Range("A1:A100").ClearContents

url = Sheets("ASIN").Range("L2").Value


With CreateObject("MSXML2.XMLHTTP")
.Open "GET", url, False
.send
oHtml.body.innerHTML = .responseText
End With


Set oElement = oHtml.getElementsByClassName("a-color-price")
For i = 0 To oElement.Length - 1
 Sheets("ASIN").Range("A" & (i + 1)) = oElement(i).innerText
Next i
Application.ScreenUpdating = True

任何使用getElementById的帮助将不胜感激。

随附了网页检查屏幕截图

enter image description here

1 个答案:

答案 0 :(得分:0)

我不确定您要指向哪个URL,但是我在屏幕快照中看到了一些TR元素以及一些TD元素。请参见下面的示例代码,并尝试将其转换为您的特定用例。

Sub Dow_HistoricalData()

    Dim xmlHttp As Object
    Dim TR_col As Object, Tr As Object
    Dim TD_col As Object, Td As Object
    Dim row As Long, col As Long

    ThisSheet = ActiveSheet.Name
    Range("A2").Select
    Do Until ActiveCell.Value = ""
    Symbol = ActiveCell.Value
    Sheets(ThisSheet).Select
    Sheets.Add

    Set xmlHttp = CreateObject("MSXML2.XMLHTTP.6.0")
    myURL = "https://www.fxstreet.com/economic-calendar"
    xmlHttp.Open "GET", myURL, False
    xmlHttp.setRequestHeader "Content-Type", "text/xml"
    xmlHttp.send

    Dim html As Object
    Set html = CreateObject("htmlfile")
    html.body.innerHTML = xmlHttp.responseText

    Dim tbl As Object
    Set tbl = html.getElementById("fxst-calendartable")


    row = 1
    col = 1

    Set TR_col = html.getElementsByTagName("TR")
    For Each Tr In TR_col
        Set TD_col = Tr.getElementsByTagName("TD")
        For Each Td In TD_col
            Cells(row, col) = Td.innerText
            col = col + 1
        Next
        col = 1
        row = row + 1
    Next

Sheets(ActiveSheet.Name).Name = Symbol
Sheets(ThisSheet).Select
ActiveCell.Offset(1, 0).Select

Loop

End Sub