VBA从URL提取地址数据运行报错 寻求解决方案

已定位的代码问题 #

• 对象赋值语法不规范：VBA中对象类型变量赋值必须使用Set关键字，原代码中Title定义为Object类型却直接用等号赋值，触发语法错误；若要获取节点文本值，应将变量定义为String类型。
• DOM解析逻辑缺陷：原代码直接给body.innerHTML赋值的方式无法完整解析页面DOM结构，且使用的#colspan选择器匹配规则错误（#前缀匹配id属性，而colspan是td标签的属性名），会返回空节点集合，调用集合第0个元素时触发"对象变量或With块变量未设置"的运行时错误。
• HTTP请求兼容问题：原代码使用的MSXML2.XMLHTTP版本过旧，未添加请求头标识容易被站点拦截；同时直接转码responseBody的方式未匹配页面UTF-8编码，容易出现乱码导致DOM解析失败。
• 缺少空值判断：原代码未判断目标节点是否存在就直接取innerText属性，只要选择器匹配失败就会直接抛出运行时错误。

修正后可运行代码 #

Public Sub IE_GetLink()
    Dim sResponse As String, HTML As Object
    Dim url As String
    Dim Re As Object
    Dim targetText As String, targetElem As Object
    
    ' 晚绑定写法无需提前引用库，兼容性更好
    Set HTML = CreateObject("htmlfile")
    Set Re = CreateObject("MSXML2.XMLHTTP.6.0")
    
    url = "http://markexpress.co.in/network1.aspx?Center=360370&Tmp=1656224682265"

    With Re
        .Open "GET", url, False
        .setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"
        ' 添加UA请求头避免被站点拦截
        .setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/125.0.0.0 Safari/537.36"
        .send
        ' 直接用responseText自动匹配编码，避免转码乱码
        sResponse = .responseText
    End With

    ' 加载HTML内容
    HTML.Write sResponse
    ' 匹配带colspan=3属性的td节点（即目标地址所在节点）
    Set targetElem = HTML.querySelector("td[colspan='3']")
    
    ' 先判断节点存在再取值，避免报错
    If Not targetElem Is Nothing Then
        targetText = targetElem.innerText
        MsgBox "提取到的地址：" & vbCrLf & targetText
    Else
        MsgBox "未匹配到目标地址节点，请检查页面结构是否变更"
    End If
End Sub

额外说明 #

若需要使用早期绑定获得代码提示，可在VBA编辑器中点击「工具-引用」，勾选Microsoft HTML Object Library和Microsoft XML, v6.0两个库后，将HTML和Re的变量类型改为对应强类型即可。

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