如何限制Excel VBA网页爬虫仅提取ECHA化学品注册档案指定子版块内容

该需求完全可实现，你提到的「定位目标标题节点后，遍历收集其后续兄弟节点直到下一个同级别标题节点为止」的思路，是当前页面无独立版块容器场景下的最优方案。

实现逻辑说明 #

该页面SectionContent下的结构是固定的：

• 每个子版块的标题为<h2>标签，innerText对应你提到的Workers - Hazard via inhalation route等版块名，标签自带唯一id
• 标题后续的所有<p>、<table>、<ul>等同级元素都属于当前版块，直到下一个<h2>标签出现，即为下一个版块的起点

修改后的VBA代码 #

Public Sub GetSpecificSectionContent()
    Dim XMLReq As New MSXML2.XMLHTTP60
    Dim HTMLDoc As New MSHTML.HTMLDocument
    Dim targetSectionTitle As String
    Dim startNode As Object, currNode As Object
    Dim resultText As String
    
    ' 配置请求
    XMLReq.Open "Get", "https://echa.europa.eu/registration-dossier/-/registered-dossier/15460/7/1", False
    XMLReq.send
    HTMLDoc.body.innerHTML = XMLReq.responseText
    
    ' 填写你要提取的目标版块标题，和页面显示完全一致即可
    targetSectionTitle = "Workers - Hazard via inhalation route"
    
    ' 定位目标版块的标题h2节点
    For Each startNode In HTMLDoc.getElementById("SectionContent").getElementsByTagName("h2")
        If Trim(startNode.innerText) = Trim(targetSectionTitle) Then
            Exit For
        End If
    Next
    
    ' 未找到目标版块直接退出
    If startNode Is Nothing Then
        Debug.Print "未找到指定版块"
        Exit Sub
    End If
    
    ' 遍历收集当前版块的所有内容节点
    Set currNode = startNode.NextSibling
    Do While Not currNode Is Nothing
        ' 遇到下一个h2标签说明到下一个版块，停止遍历
        If UCase(currNode.TagName) = "H2" Then Exit Do
        ' 拼接内容，过滤掉空的文本节点
        If Trim(currNode.innerText) <> "" Then
            resultText = resultText & currNode.innerText & vbCrLf
        End If
        Set currNode = currNode.NextSibling
    Loop
    
    ' 输出结果
    Debug.Print "===== " & targetSectionTitle & " =====" & vbCrLf & resultText
End Sub

优化建议 #

• 如果需要频繁切换提取不同版块，可以把上述逻辑封装为自定义函数，传入版块标题即可返回对应内容
• 如果需要兼容不同Office版本，可将MSXML2.XMLHTTP60和MSHTML.HTMLDocument改为晚绑定写法，无需手动引用库
• 匹配标题时可增加模糊匹配逻辑，避免页面标题有细微空格、符号差异导致匹配失败

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