excel - 如何使用 VBA 从 Bloomberg 的网站上抓取数据

Question

背景

免责声明：我是初学者，请裸露我的 - 最有可能是错误的 - 代码。

我想使用启用按钮的 VBA 宏来更新货币对的值（ PREV CLOSE ）。我的 Excel 工作表在G:G 列上包含 FX 对（例如 USDGBP），然后用于为列中的每一对运行 FOR 循环。

然后该值将存储在I:I 列中

现在，根据调试器的问题在于我将在下面突出显示的一行代码

来源

我从https://www.youtube.com/watch?v=JxmRjh-S2Ms&t=1050s获得了一些灵感- 特别是从 17:34 开始 - 但我希望我的代码只需按一下按钮就可以在多个网站上工作。

我试过下面的代码

Public Sub Auto_FX_update_BMG()

    Application.ScreenUpdating = False  'My computer is not very fast, thus I use this line of
                                        'code to save some computing power and time

    Dim internet_object As InternetExplorer
    Dim i As Integer

         For i = 3 To Sheets(1).Cells(3, 7).End(xlDown).Row
              FX_Pair = Sheets(1).Cells(i, 7)

              Set internet_object = New InternetExplorer
              internet_object.Visible = True
              internet_object.navigate "https://www.bloomberg.com/quote/" & FX_Pair & ":CUR"

              Application.Wait Now + TimeValue("00:00:05")

              internet_object.document.getElementsByClassName("class")(0).getElementsByTagName ("value__b93f12ea")  '--> DEBUGGER PROBLEM
                                                                                                                    'My goal here is to "grab" the PREV CLOSE
                                                                                                                    'value from the website
                    With ActiveSheet
                        .Range(Cells(i, 9)).Value = HTML_element.Children(0).textContent
                    End With

             Sheets(1).Range(Cells(i, 9)).Copy   'Not sure if these 2 lines are unnecesary
             ActiveSheet.Paste

         Next i

    Application.ScreenUpdating = True

End Sub

预期结果

当我在G:G 列的单元格上输入“USDGBP”时，宏将转到https://www.bloomberg.com/quote/EURGBP:CUR并“获取” PREV CLOSE 值 0.8732（使用今天的值）并将其插入到I:I 列的相应行中

截至目前，我只是面对调试器，对如何解决问题没有太多想法。

标签： excelvbaweb-scraping

Answer 1

您可以在循环中使用类选择器。图案

.previousclosingpriceonetradingdayago .value__b93f12ea

指定获取具有类的子元素， value__b93f12ea其父类具有类previousclosingpriceonetradingdayago。这 ”。” 前面是一个 css类选择器，是一种更快的选择方式，因为现代浏览器针对 css 进行了优化。两个类之间的空间是后代组合子。querySelector 从网页 html 文档中返回此模式的第一个匹配项。

这在页面上匹配：

您可以在这里再次看到父子关系和类：

<section class="dataBox previousclosingpriceonetradingdayago numeric">
    <header class="title__49417cb9"><span>Prev Close</span></header>
    <div class="value__b93f12ea">0.8732</div>
</section>

---

注意 如果您是 Bloomberg 客户，请查看他们的API。此外，您很可能可以从其他专用 API 获得相同的信息，这将允许更快、更可靠的 xhr 请求。

---

VBA（互联网浏览器）：

Option Explicit
Public Sub test()
    Dim pairs(), ws As Worksheet, i As Long, ie As Object
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    Set ie = CreateObject("InternetExplorer.Application")
    With ws
        pairs = Application.Transpose(.Range("G2:G" & .Cells(.rows.Count, "G").End(xlUp).Row).Value) ' assumes pairs start in row 2
    End With
    Dim results()
    ReDim results(1 To UBound(pairs))
    With ie
        .Visible = True
        For i = LBound(pairs) To UBound(pairs)
            .Navigate2 "https://www.bloomberg.com/quote/" & pairs(i) & ":CUR", False
             While .Busy Or .readyState < 4: DoEvents: Wend
             results(i) = .document.querySelector(".previousclosingpriceonetradingdayago .value__b93f12ea").innerText
        Next
        .Quit
    End With
    ws.Cells(2, "I").Resize(UBound(results), 1) = Application.Transpose(results)
End Sub

---

对于非常有限数量的请求（导致阻塞），您可以使用 xhr request 并正则表达式输出该值。我假设对在第一张纸上并从 G2 开始。我还假设 G 列中没有空单元格或无效对，直到要搜索的最后一对。否则，您将需要开发代码来处理此问题。

在这里尝试正则表达式

Option Explicit
Public Sub test()
    Dim re As Object, pairs(), ws As Worksheet, i As Long, s As String
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    Set re = CreateObject("VBScript.RegExp")
    With ws
        pairs = Application.Transpose(.Range("G2:G" & .Cells(.rows.Count, "G").End(xlUp).Row).Value) ' assumes pairs start in row 2
    End With
    Dim results()
    ReDim results(1 To UBound(pairs))
    With CreateObject("MSXML2.XMLHTTP")
        For i = LBound(pairs) To UBound(pairs)
            .Open "GET", "https://www.bloomberg.com/quote/" & pairs(i) & ":CUR", False
            .send
            s = .responseText
            results(i) = GetCloseValue(re, s, "previousClosingPriceOneTradingDayAgo%22%3A(.*?)%2")
        Next
    End With
    ws.Cells(2, "I").Resize(UBound(results), 1) = Application.Transpose(results)
End Sub
Public Function GetCloseValue(ByVal re As Object, inputString As String, ByVal pattern As String) As String 'https://regex101.com/r/OAyq30/1
    With re
        .Global = True
        .MultiLine = True
        .IgnoreCase = False
        .pattern = pattern
        If .test(inputString) Then
            GetCloseValue = .Execute(inputString)(0).SubMatches(0)
        Else
            GetCloseValue = "Not found"
        End If
    End With
End Function

---