Sub TestExchangeRate()
Dim rate As Double
rate = GetExchangeRate("USD", "EUR")
MsgBox "Der Wechselkurs von USD zu EUR ist: " & rate
End Sub
Function GetExchangeRate(fromCurrency As String, toCurrency As String) As Double
Dim ws As Worksheet
Dim tempCell As Range
Dim EXR As Double
set ws = activesheet
Set tempCell = ws.range("A1")
tempCell.Value = fromCurrency & "/" & toCurrency
tempCell.ConvertToLinkedDataType ServiceID:=268435456, LanguageCulture:="en-US"
On Error Resume Next
EXR = Evaluate("=A1.[Price]")
If Err.Number <> 0 Then
EXR = -1
End If
On Error GoTo 0
ws.Cells.Clear
GetExchangeRate = EXR
End Function