Excel VBA爬取FloatRates历史汇率报错#VALUE!及XML匹配取汇率问题

触发报错的核心问题点 #

• 解析对象错配：接口请求参数指定返回XML格式数据，原代码却创建HTML DOM解析对象接收XML响应，对象类型不兼容直接触发运行时错误，最终在单元格返回#VALUE!
• 变量逻辑缺陷：代码中判断匹配状态的RateFound变量从未显式声明初始化，默认空值导致判断分支永久失效
• 取值逻辑错位：原代码循环遍历class为row的元素时，匹配到目标货币名称后，取的是循环内的下一个元素内容，并非同一行对应的汇率值，取值完全错位
• 请求参数不兼容：直接将日期类型变量拼接进请求URL，受本地Excel区域日期格式影响，拼接出的带斜杠/点号的日期格式无法被接口识别，会返回空错误页
• 关于“定位第3列取值”的思路：该方法并非完全不可行，但稳定性极差，只要页面表格列顺序调整、新增字段，定位就会失效。接口本身返回结构化XML数据，直接按XML节点匹配取值，稳定性远高于硬数表格列数。

修正后的可用VBA代码 #

Function GetHistoricFX(fromCurr As String, toCurr As String, AsofDate As Date) As Variant
    ' 显式声明所有变量，避免类型不匹配
    Dim xmlHttp As Object
    Dim sUrl As String
    Dim xmlDoc As Object
    Dim currencyNodes As Object
    Dim currNode As Object
    Dim RateFound As Boolean
    RateFound = False
    
    On Error GoTo ErrorHandler
    ' 调用稳定版本的XMLHTTP组件
    Set xmlHttp = CreateObject("MSXML2.XMLHTTP.6.0")
    
    ' 拼接合规格式的请求URL，日期强制转接口要求的yyyy-mm-dd格式
    sUrl = "http://www.floatrates.com/historical-exchange-rates.html?" & _
           "currency_date=" & Format(AsofDate, "yyyy-mm-dd") & _
           "&base_currency_code=" & UCase(Trim(fromCurr)) & _
           "&format_type=xml"
    
    ' 发送同步请求
    xmlHttp.Open "GET", sUrl, False
    xmlHttp.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
    xmlHttp.send
    
    ' 校验请求状态合法性
    If xmlHttp.readyState = 4 And xmlHttp.Status = 200 Then
        ' 直接加载XML响应为XML DOM对象，不需要HTML解析
        Set xmlDoc = CreateObject("MSXML2.DOMDocument.6.0")
        xmlDoc.LoadXML xmlHttp.responseText
        
        ' 获取所有货币条目节点
        Set currencyNodes = xmlDoc.SelectNodes("//item")
        ' 循环匹配目标货币
        For Each currNode In currencyNodes
            ' 忽略大小写匹配货币代码
            If UCase(Trim(currNode.SelectSingleNode("code").Text)) = UCase(Trim(toCurr)) Then
                ' 取对应节点下的汇率值返回
                GetHistoricFX = currNode.SelectSingleNode("exchangeRate").Text
                RateFound = True
                Exit Function
            End If
        Next
        ' 遍历完成未匹配到对应货币的场景返回提示
        If Not RateFound Then GetHistoricFX = "未查询到对应货币汇率"
    Else
        GetHistoricFX = "接口请求失败，错误状态码：" & xmlHttp.Status
    End If
    
ExitCleanup:
    ' 手动释放所有组件资源
    Set currNode = Nothing
    Set currencyNodes = Nothing
    Set xmlDoc = Nothing
    Set xmlHttp = Nothing
    Exit Function
ErrorHandler:
    GetHistoricFX = "函数运行异常：" & Err.Description
    Resume ExitCleanup
End Function

使用说明 #

• 函数返回类型调整为Variant，既可以返回数值型汇率，也可以返回错误提示文本，不会因为类型不匹配再次触发报错
• 自动对输入的货币代码做去空格、转大写处理，不受输入内容的格式影响
• 日期参数强制转换为接口要求的yyyy-mm-dd格式拼接，完全规避本地区域日期格式导致的请求失败问题
• 直接解析XML结构化节点，不需要依赖HTML表格的列数位置，只要接口XML的字段结构不变，哪怕页面HTML排版调整，函数也能正常运行

注意：添加完自定义函数后，需要将Excel的宏安全设置调整为信任VBA工程对象模型，否则函数调用会被拦截。

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