从网站到 excel 的 VBA 复制 etf 价格

Question

我需要一些帮助来使用 vba 从网站获取数据。我在 excel 中有带有 etf 代码、链接和价格的表格，并使用 vba 我尝试从每个链接获取昨天的收盘价，但问题是我不确定在这个地方写什么“HTMLDoc.getElementById(”??? “）”。我无法从该网站的 html 代码中找到任何 ID，希望你能帮助我。

网站示例：https://www.boerse-frankfurt.de/en/etf/amundi-prime-global-ucits-etf-dr-c/price-history/historical-prices-and-volumes

我的代码：

Sub GetETFPrices()
    Dim IE As New InternetExplorer
    Dim HTMLDoc As HTMLDocument
    Dim ETFLink As String
    Dim ETFPrice As String
    Dim i As Long

    ' Loop through each row in the table
    For i = 2 To ThisWorkbook.Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).row
        ETFLink = ThisWorkbook.Worksheets("Sheet1").Cells(i, 2).Value ' Get link from column 2
        
        ' Opening the link in Internet Explorer
        IE.Navigate ETFLink

        
        Do While IE.Busy
            DoEvents
        Loop

        ' Get the ETF price element from the HTML document
        Set HTMLDoc = IE.document
        Set ETFRow = HTMLDoc.getElementById("???").Rows(HTMLDoc.getElementById("???").Rows.Length - 1)
        ETFPrice = ETFRow.Cells(3).innerText

        ' Updating the price column in Excel sheet
        ThisWorkbook.Worksheets("Sheet1").Cells(i, 3).Value = ETFPrice
    Next i

    IE.Quit
End Sub

Answer 1

如果您不必使用 Internet Explorer，我建议使用与 Chrome（和 FireFox）兼容的Selenium。

现在查看您链接的页面，在这种情况下，您的数据位于表格中，并且没有

id

属性可让您定位特定单元格。因此，我建议从 Excel 页面导入整个表格，然后您可以更轻松地导航以找到您感兴趣的数据点。

例如，您可以使用这种方法：

Sub ImportHtmlTable()

    'Initialize Selenium
    Dim bot As WebDriver
    Set bot = New WebDriver
    
    bot.Start "chrome", "YourUrl"
    bot.Get "/"
    DoEvents

    Dim Tables As WebElements
    Set Tables = bot.FindElementsByTag("table")

    Dim wb As Workbook
    Set wb = Workbooks("YourWorkbookName")
    HtmlTablesToRange Tables, wb.Sheets(1).Range("A1")
    
    bot.Close
    Set bot = Nothing

End Sub

'Inspired by code from: https://www.vba-market.com/
Sub HtmlTablesToRange(Tables As WebElements, Destination As Range)

    Destination.CurrentRegion.ClearContents

    Dim tb As WebElement
    Dim ths As WebElements 'Headers (th)
    Dim trs As WebElements 'Rows    (tr)
    Dim tds As WebElements 'Columns (td)
    
    For Each tb In Tables
    
        Dim theads As WebElements
        Set theads = tb.FindElementsByTag("thead")
        Dim thead As WebElement
        For Each thead In theads
            Set trs = thead.FindElementsByTag("tr")
            Dim tr As WebElement
            For Each tr In trs
                Set ths = tr.FindElementsByTag("th")
                Dim y As Long, z As Long
                y = 0 ' Resets back to first column
                Dim th As WebElement
                For Each th In ths
                    Destination.Offset(z, y).Value = th.text
                    y = y + 1
                Next th
                z = z + 1
            Next tr
        Next thead
 
        Dim tbodys As WebElements
        Set tbodys = tb.FindElementsByTag("tbody")
        Dim tbody As WebElement
        For Each tbody In tbodys
            Set trs = tbody.FindElementsByTag("tr")
            For Each tr In trs
                Set tds = tr.FindElementsByTag("td")
                y = 0 ' Resets back to first column
                Dim td As WebElement
                For Each td In tds
                    Destination.Offset(z, y).Value = td.text
                    y = y + 1
                Next td
                z = z + 1
            Next tr
        Next tbody
        z = z + 1
    Next tb

End Sub

如果需要提高性能，也可以在代码执行过程中关闭

Application.ScreenUpdating

请注意，您可能需要更新 Chrome 驱动程序 通常位于 C:\Users\YourUserName\AppData\Local\SeleniumBasic

免责声明：始终确保您被允许从您感兴趣的网站收集数据。