我正在尝试获取多种货币的数据，并将其全部转换为欧元。 我在该网站上找到了一个代码，但是该代码对我来说太高级了，无法用我的知识进行调试。
我隔离出错误，这是代码到达 xhr.send 时。您知道为什么会发生这种情况吗？
我不知道这部分在做什么，因此我很难调试它。
我收到的错误消息如下：
运行时错误'-2147012889（80072ee7）'自动化错误
Sub test()
Dim test1 As Variant
test1 = ConvCurrency(1, "USD", "GBP")
MsgBox (test1)
End Sub
''
' UDF to convert a currency using the daily updated rates fron the European Central Bank '
' =ConvCurrency(1, "USD", "GBP") '
''
Public Function ConvCurrency(Value, fromSymbol As String, toSymbol As String)
Static rates As Collection, expiration As Date ' cached / keeps the value between calls '
If DateTime.Now > expiration Then
Dim xhr As Object, node As Object
expiration = DateTime.Now + DateTime.TimeSerial(1, 0, 0) ' + 1 hour '
Set rates = New Collection
rates.Add 1#, "EUR"
Set xhr = CreateObject("Msxml2.ServerXMLHTTP.6.0")
xhr.Open "GET", "https://www.ecb.europa.eu/stats/eurofxref/eurofxref-daily.xml", False
xhr.Send
For Each node In xhr.responseXML.SelectNodes("//*[@rate]")
rates.Add Conversion.Val(node.GetAttribute("rate")), node.GetAttribute("currency")
Next
End If
ConvCurrency = (Value / rates(fromSymbol)) * rates(toSymbol)
End Function
编辑：对于以后的读者，我将对象更改为 msxml2.xmlhttp ，现在可以使用了。
答案 0 :(得分：2)
浏览时看起来不错，除了 object ，我认为应该使用：
CreateObject("MSXML2.ServerXMLHTTP")
您可以在我的项目VBA.CurrencyExchange中检出类似的代码，该代码可以从10个来源中检索费率。这里要发布的代码太多，但是ECB的基本功能是：
' 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中。