1

  1. 我正在尝试将 FloatRates 上的 XML 中的历史汇率抓取到 Excel 表中的单元格中。它目前正在返回 #VALUE!。

  2. 我不知道如何正确引用 XML 结构。面临的一个困难是我想通过匹配 <td> 中的货币名称（例如 Euro）来检索 <td align="right" > 中的汇率（例如 0.83）。请参阅下面的 XML 结构。我用谷歌搜索但无济于事，但像识别第 3 列？

任何帮助表示赞赏 - 谢谢！

http://www.floatrates.com/historical-exchange-rates.html?currency_date=2021-02-04&base_currency_code=USD&format_type=xml

单元格中的公式（表格）

=GetHistoricFX([@[PURCHASE FX]],[@[SALE FX]],[@ETA])

XML 结构

xml结构1

VBA

Function GetHistoricFX(fromCurr As String, toCurr As String, AsofDate As Date) As String

Dim xmlHttp As Object
Dim sUrl As String
Dim xmldoc As Object
Dim TDelements As Object
Dim TDelement As Object


' Create an XMLHTTP object
Set xmlHttp = CreateObject("MSXML2.XMLHTTP")

' get the URL to open
sUrl = "http://www.floatrates.com/historical-exchange-rates.html?" _
& "currency_date=" & AsofDate _
& "&base_currency_code=" & fromCurr _
& "&format_type=xml"


' open connection and get data
xmlHttp.Open "GET", sUrl, False
xmlHttp.send

Set xmldoc = CreateObject("xmlfile")

With xmldoc
    If xmlHttp.readyState = 4 And xmlHttp.Status = 200 Then 'readystate checks loading, status checks the validity of URL
'assign the returned text to a HTML document
.body.innerText = xmlHttp.responseText
  
Set TDelements = .getElementsByClassName("row")
'Loop within Table elements
For Each TDelement In TDelements
    If RateFound = True Then
        GetHistoricFX = TDelement.innerText
        Exit For
    End If
    If TDelement.innerText = toCurr Then RateFound = True
Next
End If
End With

Set xmlHttp = Nothing

End Function
4

2 回答 2

1

正如所评论的，发布的特定 URL 是一个 XML，它使用 XSLT 样式表将页面呈现为 HTML。但底层来源和响应文本是XML。Ctrl使用+查看 XML 数据源U：

XML

<?xml version="1.0" encoding="utf-8"?>
<?xml-stylesheet type="text/xsl" href="http://www.floatrates.com/currency-rates.xsl" ?>
<channel>
    <title>XML Historical Foreign Exchange Rates for U.S. Dollar (USD) (4 Feb 2021)</title>
    <link>http://www.floatrates.com/currency/usd/</link>
    <xmlLink>http://www.floatrates.com/daily/usd.xml</xmlLink>
    <description>XML historical foreign exchange rates for U.S. Dollar (USD) from the Float Rates. Published at 4 Feb 2021.</description>
    <language>en</language>
    <baseCurrency>USD</baseCurrency>
    <pubDate>Thu, 4 Feb 2021</pubDate>
    <lastBuildDate>Thu, 4 Feb 2021</lastBuildDate>
    
    <item>
        <title>1 USD = 0.832481 EUR</title>
        <link>http://www.floatrates.com/usd/eur/</link>
        <description>1 U.S. Dollar = 0.832481 Euro</description>
        <pubDate></pubDate>
        <baseCurrency>USD</baseCurrency>
        <baseName>U.S. Dollar</baseName>
        <targetCurrency>EUR</targetCurrency>
        <targetName>Euro</targetName>
        <exchangeRate>0.832481</exchangeRate>
        <inverseRate>1.201229</inverseRate>
        <inverseDescription>1 Euro = 1.201229 U.S. Dollar</inverseDescription>
    </item>
    <item>
        <title>1 USD = 0.733621 GBP</title>
        <link>http://www.floatrates.com/usd/gbp/</link>
        <description>1 U.S. Dollar = 0.733621 U.K. Pound Sterling</description>
        <pubDate></pubDate>
        <baseCurrency>USD</baseCurrency>
        <baseName>U.S. Dollar</baseName>
        <targetCurrency>GBP</targetCurrency>
        <targetName>U.K. Pound Sterling</targetName>
        <exchangeRate>0.733621</exchangeRate>
        <inverseRate>1.363101</inverseRate>
        <inverseDescription>1 U.K. Pound Sterling = 1.363101 U.S. Dollar</inverseDescription>
    </item>
    ...
</channel>

但是您仍然可以解析响应返回并在<item>节点数据上运行 XPath。只需使用 MSXML 的DomDocumentwithLoadXML和 SelectNodes方法。

VBA

Sub CallFunc()
    Call GetHistoricFX("USD", "", "2021-02-04")
End Sub

Function GetHistoricFX(fromCurr As String, toCurr As String, AsofDate As Date) As String
On Error GoTo ErrHandle
    Dim xmlHttp As Object
    Dim sUrl As String
    Dim xmldoc As Object, itemNodes As Object, itemNode As Variant, chNode As Variant
    Dim i As Long, j As Long
          
    ' Create an XMLHTTP object
    Set xmlHttp = CreateObject("MSXML2.XMLHTTP")
    
    ' get the URL to open
    sUrl = "http://www.floatrates.com/historical-exchange-rates.html?" _
            & "currency_date=" & AsofDate _
            & "&base_currency_code=" & fromCurr _
            & "&format_type=xml"
        
    ' open connection and get data
    xmlHttp.Open "GET", sUrl, False
    xmlHttp.send
    
    ' CREATE A DOMDocument OBJECT FROM RESPONSE
    Set xmldoc = CreateObject("MSXML2.DOMDocument")
    xmldoc.LoadXML xmlHttp.responseText
    xmldoc.setProperty "SelectionLanguage", "XPath"

    Set itemNodes = xmldoc.SelectNodes("//item")

    ' ITERATE THROUGH ITEM NODES AND CHILDREN
    With ThisWorkbook.Worksheets("MAIN")
        i = 2
        For Each itemNode In itemNodes
            j = 1
            For Each chNode In itemNode.SelectNodes("*")
                If i = 2 Then
                    .Cells(i - 1, j) = chNode.tagName
                End If
                .Cells(i, j).Value = chNode.Text
                j = j + 1
            Next chNode
            i = i + 1
        Next itemNode
    End With
    
    MsgBox "Successfully completed!", vbInformation
    
ExitHandle:
    Set chNode = Nothing
    Set itemNode = Nothing
    Set itemNodes = Nothing
    Set xmldoc = Nothing
    Set xmlHttp = Nothing
    Exit Function
    
ErrHandle:
    MsgBox Err.Number & " - " & Err.Description, vbCritical
    Resume ExitHandle
End Function

输出

Excel 输出

于 2021-02-05T21:12:21.367 回答
0

好的，我现在已经投入了时间。没有那么多。

我已经用它测试过=GetHistoricFX("USD";"EUR";"2021-02-04")

Public Function GetHistoricFX(fromCurr As String, toCurr As String, AsofDate As Date) As String

Dim xmlHttp As Object
Dim sUrl As String
Dim doc As Object
Dim TDelements As Object
Dim TDelement As Long
Dim result As String

  'Create an XMLHTTP object
  Set xmlHttp = CreateObject("MSXML2.XMLHTTP")
  Set doc = CreateObject("htmlFile")
  
  'get the URL to open
  sUrl = "http://www.floatrates.com/historical-exchange-rates.html?" _
  & "currency_date=" & AsofDate _
  & "&base_currency_code=" & fromCurr _
  & "&format_type=html"
  
  'open connection and get data
  xmlHttp.Open "GET", sUrl, False
  xmlHttp.send
  
  With doc
    If xmlHttp.Status = 200 Then
      'assign the returned text to a HTML document
      .body.innerHTML = xmlHttp.responseText
      Set TDelements = .getElementsByTagName("td")
      'Loop within Table elements
      For TDelement = 0 To TDelements.Length - 1
        If UCase(TDelements(TDelement).innerText) = UCase(toCurr) Then
          result = TDelements(TDelement + 1).innerText
          Exit For
        End If
      Next
    End If
  End With
  
  If Len(result) = 0 Then
    result = "#NL" 'like #NA is 'Not Available', #NL is 'Not Loaded'
  End If
  
  GetHistoricFX = result
End Function
于 2021-02-05T18:03:23.493 回答