VBA爬取StreetEasy页面时如何精准提取无ID标签的价格等字段

前置依赖配置 #

首先确保VBA编辑器中已勾选引用：

• 工具 → 引用 → 勾选Microsoft Internet Controls
• 工具 → 引用 → 勾选Microsoft HTML Object Library

原代码核心问题 #

• 循环终止逻辑错误：Exit For放置在If判断外，第一次遍历就强制退出，无法匹配目标元素
• 匹配规则错误：details类元素包含字段名和字段值的组合，直接判断innerText = "price"无法命中带实际值的内容
• 定位方式效率低：全量遍历details类元素冗余度高，无法精准定位目标字段

修复后完整代码 #

Option Explicit
Sub VBAWebscraping2()
    Dim IEObject As InternetExplorer
    Dim IEDocument As HTMLDocument
    Dim targetUrl As String
    
    ' 初始化IE对象
    Set IEObject = New InternetExplorer
    IEObject.Visible = True
    targetUrl = "https://streeteasy.com/building/" & Cells(2, 4).Value
    IEObject.navigate url:=targetUrl
    
    ' 等待页面加载完成
    Do While IEObject.Busy = True Or IEObject.readyState <> READYSTATE_COMPLETE
        Application.Wait Now + TimeValue("00:00:01")
    Loop
    Set IEDocument = IEObject.document
    
    ' ----------------------
    ' 1. 提取价格
    ' ----------------------
    Dim priceEle As IHTMLElement
    On Error Resume Next
    Set priceEle = IEDocument.querySelector(".price")
    On Error GoTo 0
    If Not priceEle Is Nothing Then
        Debug.Print "价格：" & Trim(priceEle.innerText)
        ' 可按需写入单元格：Cells(2,5) = Trim(priceEle.innerText)
    End If
    
    ' ----------------------
    ' 2. 提取房间数、卫浴数
    ' ----------------------
    Dim factItems As IHTMLElementCollection
    Dim factItem As IHTMLElement
    Set factItems = IEDocument.getElementsByClassName("listing_facts_item")
    For Each factItem In factItems
        If InStr(1, factItem.innerText, "bed", vbTextCompare) > 0 Then
            Debug.Print "房间数：" & Trim(Replace(factItem.innerText, "bed", ""))
            ' 可按需写入单元格：Cells(2,6) = Trim(Replace(factItem.innerText, "bed", ""))
        ElseIf InStr(1, factItem.innerText, "bath", vbTextCompare) > 0 Then
            Debug.Print "卫浴数：" & Trim(Replace(factItem.innerText, "bath", ""))
            ' 可按需写入单元格：Cells(2,7) = Trim(Replace(factItem.innerText, "bath", ""))
        End If
    Next
    
    ' ----------------------
    ' 3. 提取所在社区
    ' ----------------------
    Dim neighborhoodEle As IHTMLElement
    On Error Resume Next
    Set neighborhoodEle = IEDocument.querySelector(".neighborhood-info a")
    On Error GoTo 0
    If Not neighborhoodEle Is Nothing Then
        Debug.Print "所在社区：" & Trim(neighborhoodEle.innerText)
        ' 可按需写入单元格：Cells(2,8) = Trim(neighborhoodEle.innerText)
    End If
    
    ' 可选：关闭IE释放资源
    ' IEObject.Quit
    ' Set IEObject = Nothing
End Sub

逻辑说明 #

使用querySelector方法传入CSS选择器可直接定位目标元素，无需全量遍历同class元素，定位精度和效率远高于原写法。所有提取逻辑都增加了异常捕获，避免元素不存在时触发代码报错。

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