如何通过VBA从HTML网站提取特定元素数据？（以Metascore为例）

问题描述 #

我正尝试从网站提取特定数据并加载到Excel工作表中，比如从Metacritic的《文明6》页面提取Metascore，该信息位于特定元素内。

我编写了如下VBA代码，但无法获取目标元素：

Private Sub URL_Load(ByVal sURL As String)
    'Variablen deklarieren
    Dim appInternetExplorer As Object
    Dim htmlTxt As String
    Dim spanTxt2 As String
    
    Set appInternetExplorer = CreateObject("InternetExplorer.Application")
    appInternetExplorer.navigate sURL
    Do: Loop Until appInternetExplorer.Busy = False
    Do: Loop Until appInternetExplorer.Busy = False
    spanTxt = appInternetExplorer.document.DocumentElement.all.tags("SPAN")
    'objSelect = appInternetExplorer.document.DocumentElement.all.tags("SPAN")
    Debug.Print htmlTxt
    Set appInternetExplorer = Nothing
    Close
    'Mache hier irgendwas mit dem Text: Parsen, ausgeben, speichern
    MsgBox "Der Text wurde ausgelesen!"
End Sub

我还尝试过以下代码，但同样无法定位到目标元素：

htmlTxt = appInternetExplorer.document.DocumentElement.outerHTML
htmlTxt1(1) = appInternetExplorer.document.DocumentElement.innerHTML
htmlTxt2 = appInternetExplorer.document.DocumentElement.innerText

请问如何才能提取到特定元素的内容？

解决方案 #

要精准定位Metascore元素，别盲目遍历所有SPAN标签，直接利用HTML元素的类选择器或ID即可——Metacritic的Metascore通常位于带有固定类名的SPAN元素中。

优化后的VBA代码 #

Private Sub ExtractMetascore(ByVal sURL As String)
    Dim ie As Object
    Dim metascoreElement As Object
    Dim metascore As String
    
    ' 创建IE对象
    Set ie = CreateObject("InternetExplorer.Application")
    With ie
        .Visible = False ' 隐藏浏览器窗口，提升运行效率
        .navigate sURL
        
        ' 等待页面完全加载（更可靠的判断逻辑）
        Do While .Busy Or .readyState <> 4
            DoEvents
        Loop
        
        ' 用CSS选择器定位Metascore元素
        On Error Resume Next
        Set metascoreElement = .document.querySelector("span.metascore_w.large.game.positive")
        On Error GoTo 0
        
        ' 提取并处理结果
        If Not metascoreElement Is Nothing Then
            metascore = metascoreElement.innerText
            Debug.Print "Metascore: " & metascore
            ' 将结果写入Excel指定单元格（示例：Sheet1的A1）
            ThisWorkbook.Sheets("Sheet1").Range("A1").Value = metascore
        Else
            MsgBox "未找到Metascore元素，请检查选择器是否正确"
        End If
        
        ' 清理资源
        .Quit
    End With
    Set ie = Nothing
    MsgBox "提取完成！"
End Sub

关键说明 #

• querySelector：通过CSS选择器直接定位目标元素，比遍历所有标签高效且精准，是现代网页元素定位的首选方式。
• 页面加载等待：用readyState <> 4结合Busy判断，确保页面完全加载后再执行提取操作，避免因页面未加载完成导致元素找不到。
• 错误处理：加入On Error Resume Next防止元素定位失败时代码崩溃，同时给出友好提示。
• Excel写入：直接将提取到的Metascore写入指定单元格，满足你加载到Excel的需求。

备选定位方案 #

如果类选择器失效，可尝试XPath定位（需确保页面结构未变）：

Set metascoreElement = .document.SelectSingleNode("//span[@class='metascore_w large game positive']")

你也可以查看页面源码，确认Metascore元素的其他特征（比如父元素ID、其他属性），调整选择器即可适配不同页面。

内容的提问来源于stack exchange，提问作者EverBlack