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?