Html 获取汇率-帮助我更新用于工作的Excel VBA代码中的URL

我使用的VBA代码正常工作，现在函数返回0，因为URL已更改。 我现在应该使用什么URL

多谢各位

Function YahooCurrencyConverter(ByVal strFromCurrency, ByVal strToCurrency, Optional ByVal strResultType = "Value")
    On Error GoTo ErrorHandler

'Init
Dim strURL As String
Dim objXMLHttp As Object
Dim strRes As String, dblRes As Double

Set objXMLHttp = CreateObject("MSXML2.ServerXMLHTTP")
strURL = "http://finance.yahoo.com/d/quotes.csv?e=.csv&f=c4l1&s=" & strFromCurrency & strToCurrency & "=X"

'Send XML request
With objXMLHttp
    .Open "GET", strURL, False
    .setRequestHeader "Content-Type", "application/x-www-form-URLEncoded"
    .Send
    strRes = .ResponseText
End With

'Parse response
dblRes = Val(Split(strRes, ",")(1))

Select Case strResultType
    Case "Value": YahooCurrencyConverter = dblRes
    Case Else: YahooCurrencyConverter = "1 " & strFromCurrency & " = " & dblRes & " " & strToCurrency
End Select

CleanExit:
    Set objXMLHttp = Nothing

Exit Function

ErrorHandler:
    YahooCurrencyConverter = 0
    GoTo CleanExit
End Function

拆分：

现在您已经获得了可以使用Split函数解析的JSON字符串。在这里，我从一个单元格的注释中读取JSON

Option Explicit
Public Sub GetExchangeRate()
    Dim json As String
    json = [A1]
    Debug.Print Split(Split(json, """5. Exchange Rate"": ")(1), ",")(0)
End Sub

JSON解析器：

在这里，您可以使用JSON解析器，然后通过VBE>工具>引用>Microsoft脚本字典添加引用

Public Sub GetRate()
    Dim jsonStr As String, json As Object
    jsonStr = [A1]
    Debug.Print JsonConverter.ParseJson(jsonStr)("Realtime Currency Exchange Rate")("5. Exchange Rate")
End Sub

这是达到所需更改率的路径：

初始对象是包含另一个字典的字典。词典用{}表示。您使用键Realtime Currency Exchange Rate访问第一个字典，然后通过关联键5访问内部字典中的所需值。汇率

带JSON解析器的整个请求：

Option Explicit
Function EURtoUSD() As Currency
    Const myAPI As String = "apikey=your_key"
    Const sURL As String = "https://www.alphavantage.co/query?function=CURRENCY_EXCHANGE_RATE&from_currency=EUR&to_currency=USD&"
    Const DOL As Currency = 1
    Dim httpRequest As WinHttpRequest
    Dim strJSON As String, JSON As Object

Set httpRequest = New WinHttpRequest
With httpRequest
    .Open "Get", sURL & myAPI
    .send
    .WaitForResponse
    strJSON = .responseText
End With
Set httpRequest = Nothing

Set JSON = ParseJson(strJSON)

EURtoUSD = JSON("Realtime Currency Exchange Rate")("5. Exchange Rate") * DOL

End Function

作为一个UDF：

Option Explicit
Public Sub Test()
    Debug.Print CurrencyConverter("EUR", "USD")
End Sub

Public Function CurrencyConverter(ByVal FromCurrency, ByVal ToCurrency) As String
    Dim URL As String, json As String, http As Object
    URL = "https://www.alphavantage.co/query?function=CURRENCY_EXCHANGE_RATE&from_currency=" & FromCurrency & "&to_currency=" & ToCurrency & "&apikey=yourAPIkey"

    Set http = CreateObject("MSXML2.XMLHTTP")
    With http
        .Open "GET", URL, False
        .setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"
        .send
        json = .responseText
    End With
    CurrencyConverter = JsonConverter.ParseJson(json)("Realtime Currency Exchange Rate")("5. Exchange Rate")
'CurrencyConverter = Replace$(JsonConverter.ParseJson(json)("Realtime Currency Exchange Rate")("5. Exchange Rate"), Application.DecimalSeparator, ".") 
End Function

使用拆分函数替换倒数第二个函数行的步骤

CurrencyConverter = Replace$(Split(Split(json, """5. Exchange Rate"": ")(1), ",")(0), Chr$(34), vbNullString)

使用JSON解析器：

Option Explicit
Function EURtoUSD() As Currency
    Const myAPI As String = "apikey=your_key"
    Const sURL As String = "https://www.alphavantage.co/query?function=CURRENCY_EXCHANGE_RATE&from_currency=EUR&to_currency=USD&"
    Const DOL As Currency = 1
    Dim httpRequest As WinHttpRequest
    Dim strJSON As String, JSON As Object

Set httpRequest = New WinHttpRequest
With httpRequest
    .Open "Get", sURL & myAPI
    .send
    .WaitForResponse
    strJSON = .responseText
End With
Set httpRequest = Nothing

Set JSON = ParseJson(strJSON)

EURtoUSD = JSON("Realtime Currency Exchange Rate")("5. Exchange Rate") * DOL

End Function

或者，您可以使用Power Query设置可刷新的数据连接

您可以通过输入URL在UI中设置查询。 运行查询后，按编辑查询

转换为表格 展开表，仅选择要保留的列 取消选择该选项以使用原始列名 完成此操作后，您可以随时按一个按钮刷新查询

这是UI生成的M代码。我还选择保留“时间更新”列：

let
    Source = Json.Document(Web.Contents("https://www.alphavantage.co/query?" & "function=CURRENCY_EXCHANGE_RATE" & "&from_currency=EUR" & "&to_currency=USD" & "&apikey=your_api")),
    #"Converted to Table" = Record.ToTable(Source),
    #"Expanded Value" = Table.ExpandRecordColumn(#"Converted to Table", "Value", {"5. Exchange Rate", "6. Last Refreshed"}, {"5. Exchange Rate", "6. Last Refreshed"}),
    #"Changed Type" = Table.TransformColumnTypes(#"Expanded Value",{{"5. Exchange Rate", Currency.Type}})
in
    #"Changed Type"

---

我相信以这种方式访问yahoo.finance已经停止。我建议您查看其他来源的货币兑换信息。似乎有一个记录良好的API，应该能够满足您的要求。但是还有其他的。这里有一个英镑美元的示例urlhttps://finance.yahoo.com/quote/GBPUSD=X?p=GBPUSD=X&.tsrc=fin-看起来有些事情已经改变了。您可以提交页面的XML请求并解析XML响应，即查找包含汇率文本值的id/标记。为此，您需要编辑strURL=。。。行并添加一个部分来解析id或tagHi，谢谢。我已经看过Alpha Vantage了，我必须用这个https://www.alphavantage.co/query?function=CURRENCY_EXCHANGE_RATE&from_currency=EUR&to_currency=USD&apikey=xxxxxxxxxx 它返回`{实时货币汇率：{1.From_货币代码：EUR，2.From_货币名称：Euro，3.To_货币代码：USD，4.To_货币名称：美元，5.汇率：1.15247200，6.上次刷新时间：2018-10-06 17:13:29，7.时区：UTC}`如何在VBA中获取5.汇率值？我将在回答中提供一些建议，谢谢。我尝试了EURtoUSD函数，但出现了编译错误，将httpRequest设置为WinHttpRequest未定义。在VBE中，我尝试添加对Microsoft XML 3.0、6.0和Microsoft HTML对象库的引用，但仍然出现该错误。还尝试了ad在system32中添加对WinHTTP.dll的引用，但这会给我错误无法添加对指定文件的引用实际错误可能有点不同，我有意大利语的Windows 10。@Dolphin975我列出的是Microsoft WinHTTP服务，版本5.1，位置为C:\Windows\system32\winhttpcom.dll，或者您可以使用late bin将原始脚本中的ding as Dim objXMLHttp设置为对象：设置objXMLHttp=CreateObjectMSXML2.ServerXMLHTTP或CreateObjectMSXML2。XMLHTTP@QHarr再次感谢你！这是我真正需要的！嗨，Qharr，我在聊天中问了你一个问题。