使用vba從網站上抓取數據

Question

我試圖從網站上抓取數據： http : //uk.investing.com/rates-bonds/financial-futures通過 vba，比如實時價格，即德國 5 年波布爾，美國 30 年國債，我嘗試過 excel網頁查詢但它只抓取整個網站，但我只想抓取速率，有沒有辦法做到這一點？

Answer 1

有幾種方法可以做到這一點。 這是我寫的一個答案，希望在瀏覽關鍵字“從網站上抓取數據”時可以找到 Internet Explorer 自動化的所有基礎知識，但請記住，沒有任何東西值得您自己研究（如果您不想堅持您無法自定義的預先編寫的代碼）。

請注意，這是一種方式，我不喜歡在性能方面（因為它取決於瀏覽器速度），但這有助於理解 Internet 自動化背后的基本原理。

1）如果我需要瀏覽網頁，我需要一個瀏覽器！ 所以我創建了一個 Internet Explorer 瀏覽器：

Dim appIE As Object
Set appIE = CreateObject("internetexplorer.application")

2）我要求瀏覽器瀏覽目標網頁。 通過使用“.Visible”屬性，我決定是否要查看瀏覽器是否完成其工作。 在構建代碼時， Visible = True很好，但是當代碼用於抓取數據時，最好不要每次都看到它，所以Visible = False 。

With appIE
    .Navigate "http://uk.investing.com/rates-bonds/financial-futures"
    .Visible = True
End With

3) 網頁需要一些時間來加載。 所以，我會在它忙的時候等待......

Do While appIE.Busy
    DoEvents
Loop

4) 好了，現在頁面被加載了。 假設我想抓取 US30Y T-Bond 的變化：我要做的只是在 Internet Explorer 上單擊 F12 以查看網頁代碼，因此使用指針（紅色圓圈中）我將單擊該元素我想刮，看看我怎樣才能達到我的目的。

5）我應該做的是直截了當的。 首先，我將通過 ID 屬性獲取包含值的tr元素：

Set allRowOfData = appIE.document.getElementById("pair_8907")

這里我會得到td元素的集合（具體來說， tr是一行數據， td是它的單元格。我們找的是第8個，所以我會寫：

Dim myValue As String: myValue = allRowOfData.Cells(7).innerHTML

為什么我寫的是 7 而不是 8？ 因為單元格的集合從0開始，所以第8個元素的索引是7（8-1）。 簡單分析這行代碼：

• .Cells()讓我訪問td元素；
• innerHTML是包含我們要查找的值的單元格的屬性。

一旦我們有了我們的值，它現在存儲在myValue變量中，我們可以關閉 IE 瀏覽器並通過將其設置為 Nothing 來釋放內存：

appIE.Quit
Set appIE = Nothing

好吧，現在你有了你的值，你可以用它做任何你想做的事情：把它放到一個單元格（ Range("A1").Value = myValue ），或者放到一個表單的標簽中（ Me.label1.Text = myValue ）。

我只想向您指出，這不是 StackOverflow 的工作方式：在這里您可以發布有關特定編碼問題的問題，但您應該先進行自己的搜索。 我回答一個沒有表現出太多研究努力的問題的原因只是我看到它被問了好幾次，回到我學會如何做到這一點的時候，我記得我本來希望有一些更好的支持開始。 所以我希望這個答案，這只是一個“研究輸入”，而不是最好/最完整的解決方案，可以為下一個遇到同樣問題的用戶提供支持。 因為感謝這個社區，我學會了如何編程，我想你和其他初學者可能會使用我的輸入來發現編程的美麗世界。

享受你的練習;)

Answer 2

還提到了其他方法，因此請讓我們承認，在撰寫本文時，我們正處於 21 世紀。 讓我們將本地總線瀏覽器打開，然后使用XMLHTTP GET請求（簡稱 XHR GET）進行飛行。

維基時刻：

XHR 是一種對象形式的 API，其方法在 Web 瀏覽器和 Web 服務器之間傳輸數據。 對象由瀏覽器的 JavaScript 環境提供

這是一種無需打開瀏覽器即可檢索數據的快速方法。 可以將服務器響應讀入 HTMLDocument 並從那里繼續抓取表格的過程。

請注意，由於沒有運行 javascript 引擎（瀏覽器中有），因此不會檢索 javascript 呈現/動態添加的內容。

在下面的代碼中，該表由其 id cr1抓取。

在輔助子WriteTable ，我們循環列（ td標簽）然后是表格行（ tr標簽），最后遍歷每個表格行的長度，一個表格單元格一個表格單元格。 由於我們只需要第 1 列和第 8 列的數據，因此使用Select Case語句指定寫出到工作表的內容。

---

示例網頁視圖：

---

示例代碼輸出：

---

VBA：

Option Explicit
Public Sub GetRates()
    Dim html As HTMLDocument, hTable As HTMLTable '<== Tools > References > Microsoft HTML Object Library
    
    Set html = New HTMLDocument
      
    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", "https://uk.investing.com/rates-bonds/financial-futures", False
        .setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT" 'to deal with potential caching
        .send
        html.body.innerHTML = .responseText
    End With
    
    Application.ScreenUpdating = False
    
    Set hTable = html.getElementById("cr1")
    WriteTable hTable, 1, ThisWorkbook.Worksheets("Sheet1")
    
    Application.ScreenUpdating = True
End Sub

Public Sub WriteTable(ByVal hTable As HTMLTable, Optional ByVal startRow As Long = 1, Optional ByVal ws As Worksheet)
    Dim tSection As Object, tRow As Object, tCell As Object, tr As Object, td As Object, r As Long, C As Long, tBody As Object
    r = startRow: If ws Is Nothing Then Set ws = ActiveSheet
    With ws
        Dim headers As Object, header As Object, columnCounter As Long
        Set headers = hTable.getElementsByTagName("th")
        For Each header In headers
            columnCounter = columnCounter + 1
            Select Case columnCounter
            Case 2
                .Cells(startRow, 1) = header.innerText
            Case 8
                .Cells(startRow, 2) = header.innerText
            End Select
        Next header
        startRow = startRow + 1
        Set tBody = hTable.getElementsByTagName("tbody")
        For Each tSection In tBody
            Set tRow = tSection.getElementsByTagName("tr")
            For Each tr In tRow
                r = r + 1
                Set tCell = tr.getElementsByTagName("td")
                C = 1
                For Each td In tCell
                    Select Case C
                    Case 2
                        .Cells(r, 1).Value = td.innerText
                    Case 8
                        .Cells(r, 2).Value = td.innerText
                    End Select
                    C = C + 1
                Next td
            Next tr
        Next tSection
    End With
End Sub

Answer 3

您可以使用 winhttprequest 對象而不是 Internet Explorer，因為加載不包括圖片和廣告的數據是很好的，而不是下載包括廣告和圖片在內的完整網頁，這些圖片使 Internet Explorer 對象與 winhttpRequest 對象相比很重。

Answer 4

這個問題很久以前就問過了。 但我認為以下信息對新手有用。 實際上，您可以像這樣輕松地從類名中獲取值。

Sub ExtractLastValue()

Set objIE = CreateObject("InternetExplorer.Application")

objIE.Top = 0
objIE.Left = 0
objIE.Width = 800
objIE.Height = 600

objIE.Visible = True

objIE.Navigate ("https://uk.investing.com/rates-bonds/financial-futures/")

Do
DoEvents
Loop Until objIE.readystate = 4

MsgBox objIE.document.getElementsByClassName("pid-8907-last")(0).innerText

End Sub

如果您不熟悉網絡抓取，請閱讀這篇博文。

網頁抓取 - 基礎

還有各種技術可以從網頁中提取數據。 本文通過示例解釋了其中的一些。

網頁抓取 - 從網頁收集數據

Answer 5

我修改了一些為我彈出錯誤的內容，最終得到了很好的效果，可以根據需要提取數據：

Sub get_data_web()

Dim appIE As Object
Set appIE = CreateObject("internetexplorer.application")

With appIE
    .navigate "https://finance.yahoo.com/quote/NQ%3DF/futures?p=NQ%3DF"
    .Visible = True
End With

Do While appIE.Busy
    DoEvents
Loop

Set allRowofData = appIE.document.getElementsByClassName("Ta(end) BdT Bdc($c-fuji-grey-c) H(36px)")

Dim i As Long
Dim myValue As String

Count = 1

    For Each itm In allRowofData

        For i = 0 To 4

        myValue = itm.Cells(i).innerText
        ActiveSheet.Cells(Count, i + 1).Value = myValue

        Next

        Count = Count + 1

    Next

appIE.Quit
Set appIE = Nothing


End Sub