除了我认为应该使用的 object 之外，它看起来还不错：
CreateObject("MSXML2.ServerXMLHTTP")
您可以查看我的项目VBA.CurrencyExchange 中的类似代码，它可以从 10 个来源检索费率。此处发布的代码太多，但欧洲央行的基本功能是：
' Retrieve the current exchange rates from the European Central Bank, ECB,
' for Euro having each of the listed currencies as the base currency.
' The rates are returned as an array and cached until the next update.
' The rates are updated once a day at about UTC 15:00.
'
' Source:
' http://www.ecb.europa.eu/stats/policy_and_exchange_rates/euro_reference_exchange_rates/html/index.en.html
'
' Note:
' The exchange rates on the European Central Bank's website are indicative rates
' that are not intended to be used in any market transaction.
' The rates are intended for information purposes only.
'
' Example:
' Dim Rates As Variant
' Rates = ExchangeRatesEcb()
' Rates(7, 0) -> 2018-05-30 ' Publishing date.
' Rates(7, 1) -> "PLN" ' Currency code.
' Rates(7, 2) -> 4.3135 ' Exchange rate.
'
' 2018-06-07. Gustav Brock, Cactus Data ApS, CPH.
'
Public Function ExchangeRatesEcb() As Variant
' Operational constants.
'
' Base URL for European Central Bank exchange rates.
Const ServiceUrl As String = "http://www.ecb.europa.eu/stats/eurofxref/"
' File to look up.
Const Filename As String = "eurofxref-daily.xml"
' Update hour (UTC).
Const UpdateHour As Date = #3:00:00 PM#
' Update interval: 24 hours.
Const UpdatePause As Integer = 24
' Function constants.
'
' Async setting.
Const Async As Variant = False
' XML node and attribute names.
Const RootNodeName As String = "gesmes:Envelope"
Const CubeNodeName As String = "Cube"
Const TimeNodeName As String = "Cube"
Const TimeItemName As String = "time"
Const CodeItemName As String = "currency"
Const RateItemName As String = "rate"
#If EarlyBinding Then
' Microsoft XML, v6.0.
Dim Document As MSXML2.DOMDocument60
Dim XmlHttp As MSXML2.ServerXMLHTTP60
Dim RootNodeList As MSXML2.IXMLDOMNodeList
Dim CubeNodeList As MSXML2.IXMLDOMNodeList
Dim RateNodeList As MSXML2.IXMLDOMNodeList
Dim RootNode As MSXML2.IXMLDOMNode
Dim CubeNode As MSXML2.IXMLDOMNode
Dim TimeNode As MSXML2.IXMLDOMNode
Dim RateNode As MSXML2.IXMLDOMNode
Dim RateAttribute As MSXML2.IXMLDOMAttribute
Set Document = New MSXML2.DOMDocument60
Set XmlHttp = New MSXML2.ServerXMLHTTP60
#Else
Dim Document As Object
Dim XmlHttp As Object
Dim RootNodeList As Object
Dim CubeNodeList As Object
Dim RateNodeList As Object
Dim RootNode As Object
Dim CubeNode As Object
Dim TimeNode As Object
Dim RateNode As Object
Dim RateAttribute As Object
Set Document = CreateObject("MSXML2.DOMDocument")
Set XmlHttp = CreateObject("MSXML2.ServerXMLHTTP")
#End If
Static Rates() As Variant
Static LastCall As Date
Dim Url As String
Dim CurrencyCode As String
Dim Rate As String
Dim ValueDate As Date
Dim ThisCall As Date
Dim Item As Integer
If DateDiff("h", LastCall, UtcNow) < UpdatePause Then
' Return cached rates.
Else
' Retrieve updated rates.
' Define default result array.
' Redim for three dimensions: date, code, rate.
ReDim Rates(0, 0 To 2)
Rates(0, RateDetail.Date) = NoValueDate
Rates(0, RateDetail.Code) = NeutralCode
Rates(0, RateDetail.Rate) = NeutralRate
Url = ServiceUrl & Filename
' Retrieve data.
XmlHttp.Open "GET", Url, Async
XmlHttp.Send
If XmlHttp.Status = HttpStatus.OK Then
' File retrieved successfully.
Document.loadXML XmlHttp.ResponseText
Set RootNodeList = Document.getElementsByTagName(RootNodeName)
' Find root node.
For Each RootNode In RootNodeList
If RootNode.nodeName = RootNodeName Then
Exit For
Else
Set RootNode = Nothing
End If
Next
If Not RootNode Is Nothing Then
If RootNode.hasChildNodes Then
' Find first level Cube node.
Set CubeNodeList = RootNode.childNodes
For Each CubeNode In CubeNodeList
If CubeNode.nodeName = CubeNodeName Then
Exit For
Else
Set CubeNode = Nothing
End If
Next
End If
End If
If Not CubeNode Is Nothing Then
If CubeNode.hasChildNodes Then
' Find second level Cube node.
Set CubeNodeList = CubeNode.childNodes
For Each TimeNode In CubeNodeList
If TimeNode.nodeName = TimeNodeName Then
Exit For
Else
Set TimeNode = Nothing
End If
Next
End If
End If
If Not TimeNode Is Nothing Then
If TimeNode.hasChildNodes Then
' Find value date.
ValueDate = CDate(TimeNode.Attributes.getNamedItem(TimeItemName).nodeValue)
' Find the exchange rates.
Set RateNodeList = TimeNode.childNodes
' Redim for three dimensions: date, code, rate.
ReDim Rates(RateNodeList.Length - 1, 0 To 2)
For Each RateNode In RateNodeList
Rates(Item, RateDetail.Date) = ValueDate
If RateNode.Attributes.Length > 0 Then
' Get the ISO currency code.
Set RateAttribute = RateNode.Attributes.getNamedItem(CodeItemName)
If Not RateAttribute Is Nothing Then
CurrencyCode = RateAttribute.nodeValue
End If
' Get the exchange rate for this currency code.
Set RateAttribute = RateNode.Attributes.getNamedItem(RateItemName)
If Not RateAttribute Is Nothing Then
Rate = RateAttribute.nodeValue
End If
Rates(Item, RateDetail.Code) = CurrencyCode
Rates(Item, RateDetail.Rate) = CDbl(Val(Rate))
End If
Item = Item + 1
Next RateNode
End If
End If
ThisCall = ValueDate + UpdateHour
' Record requested language and publishing time of retrieved rates.
LastCall = ThisCall
End If
End If
ExchangeRatesEcb = Rates
End Function
不过，我没有在 Excel 中检查过，只在 Access 中检查过。