Excel 365中VBA网页文本提取失效问题及解决方案咨询

• 一段提取网页纯文本的VBA代码在Excel 2010中可正常运行，仅返回页面文本内容；
• 在Excel 365（非企业版，数年前更新后）中失效，返回内容混杂JavaScript、CSS代码与文本；
• Office 365企业版可正常执行该代码。

需解决两个问题：

1. 如何修改代码，让它在Excel 365中实现和Excel 2010一致的纯文本提取效果？
2. 为何代码在不同Excel版本中表现存在差异？

示例代码：

Sub EstraiTestoDaPaginaWeb()
    Dim xmlHttp As Object
    Dim html As Object
    Dim testoEstratto As String
    Dim elem As Object

    ' Creazione dell'oggetto XMLHTTP
    Set xmlHttp = CreateObject("MSXML2.XMLHTTP.6.0")

    ' URL della pagina web
    Dim url As String
    url = "https://www.borsaitaliana.it/borsa/obbligazioni/mot/btp/scheda/IT0001086567.html?lang=it"

    ' Invio della richiesta
    xmlHttp.Open "GET", url, False
    xmlHttp.send

    ' Creazione dell'oggetto HTMLDocument
    Set html = CreateObject("HTMLFILE")
    html.body.innerHTML = xmlHttp.responseText

    ' Estrazione del testo
    testoEstratto = html.body.innerText

    ' Visualizzare il testo estratto
    MsgBox testoEstratto
End Sub

1. 适配Excel 365的代码修改 #

原代码使用HTMLFILE对象解析HTML时，非企业版Excel 365对现代HTML的解析逻辑发生变化，导致未过滤脚本、样式等非文本内容。可通过以下方式修复：

方法一：启用标准解析模式 #

通过设置designMode为On，强制HTML解析器使用标准模式处理内容，恢复innerText的纯文本过滤能力：

Sub EstraiTestoDaPaginaWeb_Fixed()
    Dim xmlHttp As Object
    Dim html As Object
    Dim testoEstratto As String

    ' 创建XMLHTTP对象
    Set xmlHttp = CreateObject("MSXML2.XMLHTTP.6.0")
    Dim url As String
    url = "https://www.borsaitaliana.it/borsa/obbligazioni/mot/btp/scheda/IT0001086567.html?lang=it"

    ' 发送请求
    xmlHttp.Open "GET", url, False
    xmlHttp.send

    ' 创建HTMLDocument并启用标准解析
    Set html = CreateObject("HTMLDocument")
    html.designMode = "On"
    html.body.innerHTML = xmlHttp.responseText

    ' 提取纯文本
    testoEstratto = html.body.innerText

    MsgBox testoEstratto
End Sub

方法二：手动过滤文本节点 #

如果上述方法无效，可递归遍历HTML节点，仅提取TEXT_NODE类型的内容：

Sub EstraiTestoDaPaginaWeb_Filtered()
    Dim xmlHttp As Object
    Dim html As Object
    Dim testoEstratto As String

    Set xmlHttp = CreateObject("MSXML2.XMLHTTP.6.0")
    Dim url As String
    url = "https://www.borsaitaliana.it/borsa/obbligazioni/mot/btp/scheda/IT0001086567.html?lang=it"

    xmlHttp.Open "GET", url, False
    xmlHttp.send

    Set html = CreateObject("HTMLFILE")
    html.body.innerHTML = xmlHttp.responseText

    ' 递归提取纯文本节点
    testoEstratto = GetPureText(html.body)
    MsgBox testoEstratto
End Sub

Function GetPureText(node As Object) As String
    Dim childNode As Object
    Dim text As String
    text = ""
    For Each childNode In node.childNodes
        If childNode.nodeType = 3 Then ' 仅处理文本节点
            text = text & Trim(childNode.nodeValue) & vbCrLf
        ElseIf childNode.nodeType = 1 Then ' 递归处理元素节点
            text = text & GetPureText(childNode)
        End If
    Next childNode
    GetPureText = text
End Function

2. 版本差异的原因 #

• 解析引擎迭代：Excel 2010基于旧版IE内核的HTML解析引擎，HTMLFILE的innerText会自动过滤脚本、样式内容；Excel 365（非企业版）更新后切换为Edge内核组件，解析逻辑调整，不再默认过滤此类内容。
• 企业版兼容策略：Office 365企业版保留了兼容旧代码的解析模式或专用组件适配，因此仍能按旧逻辑执行。
• 安全策略调整：非企业版Excel 365的安全更新限制了HTMLFILE的自动过滤行为，避免潜在脚本执行风险，导致原本被过滤的代码内容被保留。

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