Excel VBA使用XMLHTTPRequest抓网页时遇运行时错误438求助

问题背景 #

在Excel 2019（365）VBA中使用MSXML2.XMLHTTP60执行网页抓取，请求状态码返回200、responseText内容正常，但执行HTMLDoc.body.innerHTML = .responseText时触发「运行时错误'438'：对象不支持该属性或方法」。现有论坛方案多针对IE环境，无法解决当前问题。

错误代码片段 #

Sub GetMetaData()
' Original idea: https://stackoverflow.com/questions/37763179/how-to-get-meta-keywords-content-with-vba-from-source-code-in-an-excel-file
' Adapted by PR to work in general i.e. not being Browser specific in any way
' 2022-09-29
Dim webrequest      As New MSXML2.XMLHTTP60
Dim responses       As Object
Dim HTMLDoc         As New MSHTML.HTMLDocument
Dim HTMLElement     As HTMLHtmlElement
Dim url As String: url = "https://access.redhat.com/support/policy/updates/errata"
Dim wk As Worksheet

Const META_TAG As String = "META"
Const META_NAME As String = "keywords"
Dim Doc As Object                      ' As work area, holding HTML
Set Doc = CreateObject("htmlfile")     ' to fake ...
Dim metaElements As Object
Dim element As Object
Dim kwd As String
Dim err As Integer
Dim myarray As Variant: ReDim myarray(0 To 20, 0 To 5000)

Set wk = Worksheets(6)    ' Hopefully a free worksheet

' Find the HTML document near the URL
With webrequest
            .Open "GET", url, True                                       ' Have to use Asynchronously (True), or I get error setting ResponseType !
            .setRequestHeader "Content-Type", "text/html, */*"           ' Replaced header, to be more specific
            '.responseType = "document"                       ' We cannot operate on any other content than HTML. Tryin, gives Runtime error 438
            ' Added below header, to ensure its compatible.
            .setRequestHeader "user-agent", "Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/70.0.3538.110 Safari/537.36"
            .send
            Debug.Print "Request Status:", .Status, .statusText   ' To see result of XMLHTTP60 request
            HTMLDoc.Body.innnerHTML = .responseText       ' CODE line giving error    ' Pick up the HTML
            Set info = HTMLDoc.getElementsByTagName(META_TAG)
            Debug.Print "We now have Document META collection (nodelist): ", info
            
            On Error Resume Next ' getting an error, just ignoring for now
End With
End Sub

核心解决线索 #

• 拼写错误：错误代码中写的是innnerHTML（多了一个字母n），正确属性名应为innerHTML，这是直接触发438错误的原因。
• HTML文档加载方式：不要直接给HTMLDoc.Body赋值，应使用HTMLDoc.Write方法加载完整响应内容，再调用HTMLDoc.Close完成解析，避免Body对象未初始化的问题。
• 异步请求未等待：代码使用异步请求（.Open第三个参数为True），但未等待请求完成就处理响应，会导致responseText未就绪。建议改为同步请求（第三个参数设为False），或添加等待逻辑：

  .send
  Do While webrequest.ReadyState <> 4
      DoEvents
  Loop
  

• 清理冗余对象：代码中创建的Doc = CreateObject("htmlfile")未实际使用，可删除以避免混淆。

修正后的示例代码 #

Sub GetMetaData()
Dim webrequest      As New MSXML2.XMLHTTP60
Dim HTMLDoc         As New MSHTML.HTMLDocument
Dim url As String: url = "https://access.redhat.com/support/policy/updates/errata"
Dim wk As Worksheet
Dim metaElements As Object
Dim element As Object
Dim kwd As String

Const META_TAG As String = "META"
Const META_NAME As String = "keywords"

Set wk = Worksheets(6)

With webrequest
    .Open "GET", url, False ' 使用同步请求
    .setRequestHeader "user-agent", "Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/70.0.3538.110 Safari/537.36"
    .send
    
    Debug.Print "Request Status:", .Status, .statusText
    
    ' 正确加载HTML文档
    HTMLDoc.Write .responseText
    HTMLDoc.Close
    
    Set metaElements = HTMLDoc.getElementsByTagName(META_TAG)
    Debug.Print "META标签数量:", metaElements.Length
    
    ' 遍历查找keywords元标签
    For Each element In metaElements
        If UCase(element.getAttribute("name")) = META_NAME Then
            kwd = element.getAttribute("content")
            Debug.Print "Keywords:", kwd
            wk.Range("A1").Value = kwd ' 写入工作表
            Exit For
        End If
    Next element
End With
End Sub

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