Funkcja pobierająca kursy walut z NBP

utworzone przez Krystian Brożek | sie 22, 2018 | Head, Tech, VBA | 17 Komentarze

Tworząc zestawienia i analizując dane w Excelu czasem potrzebujemy aktualnych danych. Są to np. kursy walut, ceny akcji lub cenę z konkretnego dnia jakiegoś produktu. Ręczne kopiowanie jest męczące i łatwo się pomylić. Znacznie lepiej skorzystać z tego, co zostało udostępniane w sieci i automatycznie pobierać dane.

Tym razem chciałbym pokazać możliwość pobierania danych z sieci. Zrobimy to na przykładzie ściągania kursów walut z NBP. W tym celu utworzymy funkcję, która na podstawie waluty i daty zwróci nam ile złotówek musimy zapłacić za jedną jednostkę.

NBP udostępnia użytkownikom API, które umożliwia pobieranie kursów walut. W skrócie to zestaw funkcji dostępnych w sieci. Wymagają jednak dodatkowego kodu, aby móc z nich korzystać. Dokumentację API udostępnionego przez Narodowy Bank Polski znajdziesz tu: api.npb.pl. Wynikiem działania takich funkcji jest dokument XML lub JSON (w dużym skrócie, to uproszczony XML). Daje to ogromną elastyczność, ponieważ nie ważne z jakiego języka programowania będziemy chcieli wywołać takie funkcje, prawie każdy obsługuje XML i JSON. Można również potraktować je jako tekst i łopatologicznie wyciągać z tych dokumentów informacje.

My skorzystamy z dokumentów XML. Jeśli chcesz zobaczyć jak wygląda taki dokument wjedź pod poniższy adres

http://api.nbp.pl/api/exchangerates/rates/c/gbp/2018-07-02/?format=xml

Jest to właśnie url, który wywołuje funkcję API. Mamy tu dwa parametry, które nas interesują. Pierwszym z nich to waluta – w tym przypadku gbp. Drugim data kursu, czyli 2 lipca 2018. Musimy jednak zachować format daty zgodny z dokumentacją NBP, czyli rrrr-mm-dd.

Zatem pierwszym krokiem w stworzeniu naszej funkcji będzie stworzenie linka i przyjęcie dwóch wyżej wspomnianych parametrów. Oczywiście zachowamy odpowiedni format daty. Do tego celu wykorzystamy funkcję Format.

Function PobierzKurs(kurs As String, data As Date)
link = "http://api.nbp.pl/api/exchangerates/rates/c/" & kurs & "/" & Format(data, "yyyy-mm-dd") & "/?format=xml"
End Function

Kolejny krok to odpalenie linka i odebranie informacji. W tym celu musimy rozbudować naszą funkcję o poniższy kod.

Function PobierzKurs(kurs As String, data As Date)
Dim hReq As Object

link = "http://api.nbp.pl/api/exchangerates/rates/c/" & kurs & "/" & Format(data, "yyyy-mm-dd") & "/?format=xml"

Set hReq = CreateObject("MSXML2.XMLHTTP")
With hReq
.Open "GET", link, False
.Send
End With

odpowiedz = hReq.ResponseText
End Function

W zmiennej odpowiedz mamy XML z odpowiedzią typu string. Zostało nam już tylko odczytanie odpowiedniej wartości. Zaczniemy od zamienienia naszej odpowiedzi w dokument XML. Aby to uczynić trzeba dodać referencję, czyli powiedzieć VBA, aby skorzystało z kodu napisanego przez kogoś. Biblioteka zawierająca wszystko o XMLu została dostarczona razem z Excelem. Zatem wystarczy ją tylko dodać do naszego makra. Wybieramy Tools-> References… i na liście wyszukujemy Microsoft XML, v6.0. Zaznaczamy, dajemy ok i już 🙂

Dim objxml As Object
Set objxml = New MSXML2.DOMDocument60
objxml.LoadXML (odpowiedz)

Zostaje nam już tylko odczytanie z XMLa interesującej nas wartości. Dla uproszczenia zrobiłem to trochę łopatologicznie. Zatem odczytuję po kolei element o indeksie 3 (czyli czwarty, bo numerujemy od 0), następnie wybieramy pierwszy podelement i z niego Bid, czyli ten o indeksie 3. Na koniec z niego odczytuję wartość.

Poniżej ścieżka jaką przeszliśmy:

ExchangeRatesSeries (DocumentElement)
Rates (wśród ChildNodes wybieram Item(3))
Rate (wśród ChildNodes wybieram Item(0))
Ask (wśród ChildNodes wybieram Item(3))
Szukana wartość (nodeTypedValue)

Function PobierzKurs(kurs As String, data As Date)
Dim hReq As Object
Dim objxml As Object

link = "http://api.nbp.pl/api/exchangerates/rates/c/" & kurs & "/" & Format(data, "yyyy-mm-dd") & "/?format=xml"

Set hReq = CreateObject("MSXML2.XMLHTTP")
With hReq
.Open "GET", link, False
.Send
End With

odpowiedz = hReq.ResponseText

Set objxml = New MSXML2.DOMDocument60
objxml.LoadXML (odpowiedz)
PobierzKurs = objxml.DocumentElement.ChildNodes.Item(3).ChildNodes.Item(0).ChildNodes.Item(3).nodeTypedValue
End Function

Istnieje jeszcze jeden problem. W niektóre dni nie było podanego kursu walut (np. w weekendy). Funkcja z NBP zwróci informację o braku danych. Dodamy zatem warunek sprawdzający, czy na końcu odpowiedzi z serwera jest napis „Brak danych”

Function PobierzKurs(kurs As String, data As Date)
Dim hReq As Object
Dim objxml As Object

link = "http://api.nbp.pl/api/exchangerates/rates/c/" & kurs & "/" & Format(data, "yyyy-mm-dd") & "/?format=xml"

Set hReq = CreateObject("MSXML2.XMLHTTP")
With hReq
.Open "GET", link, False
.Send
End With

odpowiedz = hReq.ResponseText

If odpowiedz Like "*Brak danych" Then
PobierzKurs = "Brak danych"
Else
Set objxml = New MSXML2.DOMDocument60
objxml.LoadXML (odpowiedz)
PobierzKurs = objxml.DocumentElement.ChildNodes.Item(3).ChildNodes.Item(0).ChildNodes.Item(3).nodeTypedValue
End If
End Function

Sporo pytań pojawiło się o odczyt danych z tabeli A, dlatego poniżej prezentuję działający kod ze zmianami:

Function PobierzKurs(kurs As String, data As Date)
Dim hReq As Object
Dim objxml As Object

link = "http://api.nbp.pl/api/exchangerates/rates/a/" & kurs & "/" & Format(data, "yyyy-mm-dd") & "/?format=xml"

Set hReq = CreateObject("MSXML2.XMLHTTP")
With hReq
.Open "GET", link, False
.Send
End With

odpowiedz = hReq.ResponseText

If odpowiedz Like "*Brak danych" Then
PobierzKurs = "Brak danych"
Else
Set objxml = New MSXML2.DOMDocument60
objxml.LoadXML (odpowiedz)
PobierzKurs = objxml.DocumentElement.ChildNodes.Item(3).ChildNodes.Item(0).ChildNodes.Item(2).nodeTypedValue
End If
End Function

No i już. Wszystko powinno działać. W ten sam sposób można korzystać z innych udostępnionych API. Trzeba znaleźć dokumentację lub samemu wywnioskować co dane API zwraca. Jeśli wykorzystujesz API w swoich projektach pochwal się w komentarzu.

W pliku dołączonym do wpisu znajdziesz gotową funkcję z przykładem działania.

17 komentarzy

Arek dnia 30 października 2018 o godz. 16:20

Bardzo Dziękuje

Jestem początkujący w tym VBA ale mam kolejny problem, gdyż dane z HTML są z kropką i nie mogę ich użyć dalej. Jak można zmodyfikować zaprezentowana funkcję poprzez dodanie formatowania – zamiana w wyniku wyszukiwania kropki na przecinek

Arek
Odpowiedz
- Krystian Brożek dnia 31 października 2018 o godz. 15:18
  
  Można skorzystać z funkcji Replace i zamienić przecinek na kropkę. Żeby wartość była w Excelu widoczna jako liczba dziesiętna trzeba jeszcze zamienić tekst na liczbę inaczej na nic nam przecinek.
  W gotowym skrypcie pomiędzy linijką 20 i 21 proszę wpisać poniższy kod – wtedy zadziała 🙂
  PobierzKurs = CDbl(Replace(PobierzKurs, „.”, „,”))
  Odpowiedz
  - Krzysiek dnia 4 marca 2019 o godz. 16:05
    
    Niestety zamiana „.” na „,” nie działa.
    Po dodaniu tej linii pojawia się błąd #ARG!
    Odpowiedz
    - Wojtek S. dnia 7 listopada 2019 o godz. 03:46
      
      Wpisz ręcznie (lub zmień ręcznie cudzysłowy), ponieważ w kopiowanej linijce one są skośne.
      Odpowiedz
Celide dnia 15 kwietnia 2019 o godz. 00:43

Czy można funkcję przeportować na MacOS? Nie ma na niego Microsoft XML, v6.0 🙁
Odpowiedz
- Krystian Brożek dnia 15 kwietnia 2019 o godz. 19:29
  
  Niestety nie mam Maca, żeby sprawdzić, ale tu znalazłem rozwiązanie: https://stackoverflow.com/questions/158633/how-can-i-send-an-http-post-request-to-a-server-from-excel-using-vba
  Odpowiedz
Bartek dnia 29 kwietnia 2019 o godz. 18:23

Witam, świetny poradnik, niestety mam problem z wyświetleniem kursu z tabeli A. Po przeanalizowaniu Pańskiego kodu, wydaję mi się, że jedyną zmianą powinno być zastąpienie w 5 linijce kodu wartości C na A. Niestety w excelu wyrzuca błąd #ARG!.
Odpowiedz
- Krystian Brożek dnia 3 maja 2019 o godz. 22:42
  
  Poza zmianą literki w linku trzeba jeszcze poprawić odczytywanie wartości.
  W tabeli C jest Bid i Ask. Ja biorę to drugie, czyli element numer 3 (liczymy od 0).
  W przypadku tabeli A jest tylko Mid, więc elementu numer 3 nie ma, a Mid stoi na pozycji 2. Trzeba więc końcówkę zmienić – ostatni Item(3) zamienić na Item(2)
  PobierzKurs = objxml.DocumentElement.ChildNodes.Item(3).ChildNodes.Item(0).ChildNodes.Item(2).nodeTypedValue
  Odpowiedz
Adam dnia 14 maja 2019 o godz. 14:13

Witam
Mam problem z powyższym kodem, otóż próbuję go zaimplementować w moim VBA do rejestrowania dokumentów firmowych, dodałem tę funkcję w Module1 i wykorzystuję tu opcje Option Explicit, więc wywala mi błędy przy „link” oraz „odpowiedz, że zmienne nie zadeklarowane. Zadeklarowałem je sobie jako stringi, i teraz pojawia się i tak błąd w linijce 20, mianowicie
PobierzKurs = objxml.DocumentElement.ChildNodes.Item(3).ChildNodes.Item(0).ChildNodes.Item(2).nodeTypedValue
(odpytuję tabelę A)
błąd mam następujący:
run time error ’91’: Object variable or with block variable not set.
Co powinienem zrobić by działało?
Odpowiedz
- Adam dnia 14 maja 2019 o godz. 14:17
  
  Dodam jeszcze, że funkcję wykorzystuję w innej funkcji, nie wywołuję jej w arkuszu tylko jako zapis do zmiennej string:
  Kurs_z_dnia = PobierzKurs(„EUR”, Data_sprz2)
  Odpowiedz
  - Krystian Brożek dnia 14 maja 2019 o godz. 22:29
    
    jeśli możesz, to podeślij mi plik na krystian@geek-on.pl. Dodałem option explicit u siebie i po zadeklarowaniu dwóch stringów i zmiany na tabelę A wszystko śmiga
    Odpowiedz
    - Adam dnia 15 maja 2019 o godz. 09:45
      
      Poradziłem sobie w trochę inny sposób, znaczy z poziomu vba wkleiłem formułę wywołania funkcji w komórkę arkusza i wtedy śmiga. Jakiś problem jest jak się wywołuje funkcję bezpośrednio w vba.
      Odpowiedz
Darek dnia 23 października 2019 o godz. 15:08

Przykładowa funkcja zwraca mi jedynie błąd: „#VALUE!”
Gdzie leży problem?
Odpowiedz
Paweł dnia 22 listopada 2019 o godz. 17:09

Cześć Krystian 🙂
Właśnie rozkminiałem podobny przykład, ale próbuję pobrać całą tabelę zamiast pojedynczego kursu. Dostosowałem kod wg API, nie mam już błędów 404 ani 400, natomiast nie wiem jak wyrzucić listę wszystkich rate’ów.
xml : http://api.nbp.pl/api/exchangerates/tables/a/2012-01-01/2012-01-31/
Kod: Sub func()
Call PobierzKurs(„EUR”, „2019-11-13”, „2019-11-20”)

End Sub
Function PobierzKurs(kurs As String, data As Date, data2 As Date)
Dim hReq As Object
Dim objxml As Object

link = „http://api.nbp.pl/api/exchangerates/tables/a/” & Format(data, „yyyy-mm-dd”) & „/” & Format(data2, „yyyy-mm-dd”) & „/?format=xml”

Set hReq = CreateObject(„MSXML2.XMLHTTP”)
With hReq
.Open „GET”, link, False
.Send
End With

'If odpowiedz Like „*Brak danych” Then
’ PobierzKurs = „Brak danych”
'Else
Set objxml = New MSXML2.DOMDocument60
objxml.LoadXML (hReq.ResponseText)
PobierzKurs = objxml.DocumentElement.ChildNodes.Item(0).ChildNodes.Item(3).ChildNodes.nodeTypedValue
'End If
Debug.Print (PobierzKurs)

End Function

Jeśli dodam Item(0) na końcu dostanę tylko jeden rate, a chcę całą listę/kolekcję.
Odpowiedz
- Paweł dnia 22 listopada 2019 o godz. 17:10
  
  Edit: już widzę,że na pewno nie powinno być argumentu „EUR” w funkcji…
  Odpowiedz
Czesiek dnia 30 kwietnia 2021 o godz. 13:46

Jedna uwaga dot.
If odpowiedz Like „*Brak danych” Then
PobierzKurs = „Brak danych”
Zwykle napis 'brak danych’ nas nie zadowala i skoro pytani dzień to sobota czy niedziela to chcemy wartość z piątku czy jaki był ostatni dzień roboczy. Zatem:
If odpowiedz Like „*Brak danych” Then
PobierzKurs = PobierzKurs(kurs, data-1)
czy jakoś tak – rekurencyjnie przejdziemy wstecz do najbliższego dnia roboczego.
Odpowiedz
Mateusz dnia 3 czerwca 2021 o godz. 08:21

Chciałem tylko powiedzieć „dziękuję”! Działa jak złoto
Odpowiedz

Funkcja pobierająca kursy walut z NBP

17 komentarzy

Prześlij komentarz Anuluj pisanie odpowiedzi

Ostatnie wpisy

Najnowsze komentarze

Archiwa

Kategorie

Meta