Vorig jaar juni schreef ik hoe ik in mijn beleggingsspreadsheet automatisch de valutakoersen bijwerk met behulp van een API. Dat werkt al ruim een jaar probleemloos. Maar afgelopen weekend kreeg ik een foutmelding toen ik mijn wekelijkse beleggingsrapportage verwerkte. Er was iets veranderd in de API.
Inmiddels moet je een abonnement nemen om de API te kunnen gebruiken. Voor kleine gebruikers zoals ik is dat gelukkig gratis. Ik heb me dus als gebruiker geregistreerd, want de functie is erg handig. Maar er zijn ook wijzigingen in de manier waarop je de API moet aanroepen. Daar moest ik dus mijn macro voor aanpassen.
Mijn functie heet GetExchangeRate. Als variabelen krijgt die mee een datum en een valuta-code. Daarmee haalt deze functie bij de API de valutakoers op van de gevraagde valuta op de gevraagde datum (in heden of verleden, uiteraard), tegen de standaard-valuta die ik in mijn spreadsheet heb ingesteld (in mijn geval de Euro). Onderstaand vind je de actuele code van deze macro:
Function GetExchangeRate(Datum As Date, toCurr As String) As Double Dim TempDate As String Dim qurl As String Dim TempOutcome As String Dim fromCurr As String TempDate = CStr(Format(Datum, "yyyy-MM-DD")) fromCurr = "EUR" qurl = "http://data.fixer.io/" & TempDate & "&access_key=jouweigenkey&base=" & fromCurr & "&symbols=" & toCurr TempOutcome = Left(Right(Application.WorksheetFunction.WebService(qurl), 10), 8) If Left(TempOutcome, 1) = ":" Then TempOutcome = Right(TempOutcome, 7) & "0" End If If Mid(TempOutcome, 2, 1) = ":" Then TempOutcome = Right(TempOutcome, 6) & "00" End If If Mid(TempOutcome, 3, 1) = ":" Then TempOutcome = Right(TempOutcome, 5) & "000" End If If Mid(TempOutcome, 4, 1) = ":" Then TempOutcome = Right(TempOutcome, 4) & "0000" End If If Mid(TempOutcome, 5, 1) = ":" Then TempOutcome = Right(TempOutcome, 3) & "00000" End If If Mid(TempOutcome, 6, 1) = ":" Then TempOutcome = Right(TempOutcome, 2) & "000000" End If If Mid(TempOutcome, 7, 1) = ":" Then TempOutcome = Right(TempOutcome, 1) & "0000000" End If GetExchangeRate = CDbl(TempOutcome / 1000000) End Function
De bovenstaande wijzigingen zijn nog niet doorgevoerd in de versie die je op mijn Downloads-pagina kunt downloaden!
Heb jij wel eens te maken met aanpassingen in jouw spreadsheets?