Excel Forum - Porady, Pomoc, Excel Help, Excel FAQ - GUS PKD

Marecki · Wysłany: 26-11-2020, 15:53 **GUS PKD**

Tematem będzie pobieranie danych z GUS-u.
Dla pokazania jak to działa będziemy pobierać numery PKD.

W załączniku pokazałem dwie wersje - Prod i Testową.
Dla wersji Prod konieczne będzie uzyskanie klucza API, które jest bezpłatne.
Na klucz czekałem 1 dzień.
Info tu:

Cytat:

https://api.stat.gov.pl/Home/RegonApi

Oczywiście PKD jest tylko przykładem, bo danych możemy wyciągnąć znacznie więcej.
W arkuszu "Nazwa raportu" dodałem spis co możemy pobrać podstawiając pod zmienną Nazwa_Raportu odpowiedni "BIR11Osxxxxxxxxxx".

Info:
Żeby pobrać PKD musimy posiadać numer REGON , bo WSDL nie przewiduje wyszukiwania po NIP-ie czy KRS-ie.

Nie jest to problem , bo mając NIP czy KRS bez problemu wyciągniemy REGON.
I tak po nitce do kłębka.

Kto chętny niech testuje, nie kosztuje to nic , nawet złamanego "Sasina". :mrgreen:

GUS_v2.xlsm

Pobierz Plik ściągnięto 399 raz(y) 35.8 KB

Rafał B. · Wysłany: 26-11-2020, 22:21

Super sprawa, dzięki!

PS
Set objXml = Nothing dla świętego spokoju ;-)

Auditorius · Wysłany: 02-12-2020, 11:07

@Marecki,

1) Kod super
2) Dodałem drobne modyfikacje nawet nie w kodzie ale w możliwościach arkusza (żeby oprócz numerków PKD wyświetlało się też rozszyfrowanie co dane PKD oznacza)
3) Przetestowałem na różnych PKD i okazuje się że GUS różnie ma opisane PKD w swojej bazie - dla jednych PKD stosuje odpowiedź z "0" na początku, dla innych nie - stąd modyfikacje w mapingach (ale to nie dotyczy kodu tylko jakości danych w bazie)

Natomiast brak możliwości sprawdzenia po NIPie to pewne ograniczenie.
'Podpiąłem' twój kod dot. BL ale on sprawdzi ok. 70% podmiotów - pozostałe skoro ich nie ma to nie pomoże w ustaleniu REGONu

W załączniku przykłady sprawdzeń z BL i spoza BL - dałoby radę podpiąć w pierwszym kroku sprawdzenie REGONu po NIPie a w drugim zaciąganie PKD ?
(bo podobne rozwiązanie zapodałeś wcześniej)

Kod:

' ******************* pobieramy REGON po NIPie ?
Set objXml = CreateObject("MSXML2.XMLHTTP")
With objXml
.Open "Post", sUrl, False

.setRequestHeader "Content-Type", "application/soap+xml; charset=utf-8"
.send (Soap)
sID = VBA.Left$(Split(.responsetext, "<ZalogujResult>")(1), 20)

Soap = FileTxt_to_string(ThisWorkbook.Path & "\Soap_DaneSzukajPodmioty.txt")
Soap = VBA.Replace(Soap, "sNip", NIP)

.Open "Post", sUrl, False
.setRequestHeader "Content-Type", "application/soap+xml; charset=utf-8"
.setRequestHeader "Sid", sID
.send (Soap)

Debug.Print Replace_Special_Char(.responsetext)

End With
End Sub

REGON = RegEx_Tab("<REGON>(.*?)<\/REGON>", Resp)
If IsArray(REGON) Then
Cells(i, j + 4).Value = REGON

End If

Function Replace_Special_Char(sStr As String) As String
sStr = sStr & VBA.Replace(sStr, "<", "<")
sStr = sStr & VBA.Replace(sStr, ">", ">")
sStr = sStr & VBA.Replace(sStr, "", vbNullString)
Replace_Special_Char = sStr
End Function

Plik DaneSzukajPodmioty

Kod:

<soap:Envelope xmlns:soap="http://www.w3.org/2003/05/soap-envelope" xmlns:ns="http://CIS/BIR/PUBL/2014/07" xmlns:dat="http://CIS/BIR/PUBL/2014/07/DataContract">
<soap:Header xmlns:wsa="http://www.w3.org/2005/08/addressing">
<wsa:To>https://wyszukiwarkaregontest.stat.gov.pl/wsBIR/UslugaBIRzewnPubl.svc</wsa:To>
<wsa:Action>http://CIS/BIR/PUBL/2014/07/IUslugaBIRzewnPubl/DaneSzukajPodmioty</wsa:Action>
</soap:Header>
<soap:Body>
<ns:DaneSzukajPodmioty>
<ns:pParametryWyszukiwania>
<dat:Nip>sNip</dat:Nip>
</ns:pParametryWyszukiwania>
</ns:DaneSzukajPodmioty>
</soap:Body>
</soap:Envelope>

GUS_v1.1 z BL REGON_PKD_lista.xlsm

Pobierz Plik ściągnięto 368 raz(y) 273.68 KB

Soap_DaneSzukajPodmioty.txt

Pobierz Plik ściągnięto 291 raz(y) 622 Bajtów

Gus_test.xlsm

Pobierz Plik ściągnięto 231 raz(y) 19.57 KB

Marecki · Wysłany: 05-12-2020, 19:10

Kod:

Sub Regon_z_Nip()
Const My_Key As String = "xxxxxxxxxxxxxx" 'Tu wpisz swój klucz z GUS-u
Const sURL As String = "https://wyszukiwarkaregon.stat.gov.pl/wsBIR/UslugaBIRzewnPubl.svc"
Dim Nazwa_Raportu As String
Dim objXml As Object
Dim Soap As String
Dim sID As Variant
Dim Resp As String
Dim REGON As Variant
Dim Nip As String
Dim i As Long
Dim j As Long
Dim PKD As Variant
Dim tmp As Variant

Range("D2:z5").ClearContents
Nazwa_Raportu = Arkusz2.Range("A7").Value
Soap = FileTxt_to_string(ThisWorkbook.Path & "\Zaloguj.txt")
Soap = VBA.Replace(Soap, "theUsersKey", My_Key)

Set objXml = CreateObject("MSXML2.ServerXMLHTTP.6.0")

'*********** Pobieramy numer sesji - SID połączenia, który wygasa po wywołaniu metody Wyloguj lub po upływie 60 minut.
With objXml

.Open "Post", sURL, False
.setRequestHeader "Content-Type", "application/soap+xml; charset=utf-8"
.send (Soap)

If .Status <> 200 Then
MsgBox Status_HTTP(.Status), vbCritical
Exit Sub
End If
Resp = .responsetext

tmp = RegEx_Tab("<ZalogujResult>(.*?)<\/ZalogujResult>", Resp)

If Not IsArray(tmp) Then
MsgBox "Prawdopodobnie podałeś zły klucz API !", vbCritical
Exit Sub
End If

sID = tmp(0)
End With

'*************** Pobieramy właściwe dane
For i = 2 To 5
With objXml
Nip = Arkusz1.Cells(i, 1).Value

Soap = FileTxt_to_string(ThisWorkbook.Path & "\nip.txt")
Soap = VBA.Replace(Soap, "sNip", Nip)

.Open "Post", sURL, False
.setRequestHeader "Content-Type", "application/soap+xml; charset=utf-8"
.setRequestHeader "Sid", sID
.send (Soap)
Resp = Replace_Special_Char(.responsetext)

REGON = RegEx_Tab("<Regon>(.*?)</Regon>", Resp)
If IsArray(REGON) Then
For j = 0 To UBound(REGON)
Cells(i, j + 2).Value = REGON(j)
Next j
End If

End With

Next i

End Sub

Nip.txt

Pobierz Plik ściągnięto 272 raz(y) 611 Bajtów

jarekkk · Exceloholic Posty: 228

Witam,

Czy jest szansa na narzędzie/kod, w którym na podstawie NIP otrzymamy zwrotnie takie informacje jak nazwa, miejscowość, ulica, nr nieruchomości, nr lokalu, kod pocztowy, miejscowość poczty? Jeśli nie, proszę o usunięcie tego zapytania/posta....( :oops:

)

Pozdrawiam Jarek.

Marecki · Wysłany: 25-02-2021, 10:31

Szansa wygląda tak jak w załączniku.

GUS_v1.0(1).xlsm

Pobierz Plik ściągnięto 367 raz(y) 32.02 KB

jarekkk · Exceloholic Posty: 228

Witaj Marecki,

Dokładnie o to chodziło, tego potrzebowałem.
MARECKI WIELKIE WIELKIE DZIĘKI!

PS
To co robisz/robicie jest niesamowite.

Pozdrawiam Jarek.

pczypek · Świeżak Wersja: Win Office 2019 Posty: 1

Hej!

Marecki, czy możesz jeszcze raz udostępnić zip z pobieraniem PKD z GUS? Niestety, aktualnie przy pobraniu 404.

Z góry wielkie dzięki!

Pozdrawiam,
Patryk

Marecki · Wysłany: 30-09-2021, 04:33

pczypek, załącznik poprawiony - dodany do pierwszego postu.

mwrevo · Świeżak Wersja: Win Office 2019 Posty: 2

Dzień dobry,
Dziękuję Panu Mareckiemu za udostępnione pliki. Mam natomiast dwa problemy:

1. Plik GUS_v1.0 - w niektórych podmiotach plik uzupełnia błędnie nr nieruchomości. Sprawdzałem formatowanie komórek, przestawiłem na "tekst" przed importem z GUS - to nie naprawiło problemu. Przedsiębiorca o nr NIP: 1070031466 ma numer nieruchomości 12/14 a Excel wpisuje 45274 ... nawet nie wiem jak się za to zabrać tym bardziej, że na stronie www GUSu wyświetla się prawidłowo.

2. Plik GUS_v2 - który pobiera PKD - czy można tak zrobić by pobierał dla większej ilości podmiotów PKD i żeby działał tak jak plik GUS_v1.0?

Panowie, nie ma opcji żebym to sam swoja głową ogarnął... za pomoc z góry dziękuję.
Mam swoją bazę Klientów w Excelu, jest w niej dużo błędów bo przypadkowe osoby wprowadzały dane. Po NIP chcę pobrać nazwę i adres, a w drugim pliku po numerze REGON PKD... siedzę nad tym piąty dzień :roll:

Info dla Admina: podczas rejestracji konta mój e-mail którego używam od 20 lat dostał bana a nic nie zrobiłem. Próbowałem się zarejestrować na dwa e-maile które są na GMailu - nie dało się.

Pozdrawiam!

mwrevo · Świeżak Wersja: Win Office 2019 Posty: 2

Rozwiązałem problem źle wyświetlanych numerów nieruchomości, jednak nie mogę na forum wstawić załącznika z poprawionym plikiem Excela bo najwidoczniej nowi użytkownicy forum nie mają takiej możliwości. Poniżej działający kod do pliku Mareckiego GUS_v1.0(1).xlsm Dodatkowo należy kolumny z danymi zmienić na "tekstowe". Na tą chwilę wydaje się działać poprawnie.

Kod:

Option Explicit

Sub Pobierz_Dane()
Const My_Key As String = "xxxxxxxxxxxxxxxxxxxx" 'Tu wpisz swój klucz z GUS-u
Const sURL As String = "https://wyszukiwarkaregon.stat.gov.pl/wsBIR/UslugaBIRzewnPubl.svc"
Dim objXml As Object
Dim Soap As String
Dim sID As Variant
Dim Resp As String
Dim Nip As String
Dim i As Long
Dim Dane As Variant
Dim ws As Worksheet

Set ws = ThisWorkbook.Worksheets("Arkusz1") ' Zmienić nazwę arkusza na właściwą

'Koperta do logowania
Soap = Soap & "<soap:Envelope xmlns:soap=""http://www.w3.org/2003/05/soap-envelope"" xmlns:ns=""http://CIS/BIR/PUBL/2014/07""> <soap:Header xmlns:wsa=""http://www.w3.org/2005/08/addressing"">"
Soap = Soap & "<wsa:Action>http://CIS/BIR/PUBL/2014/07/IUslugaBIRzewnPubl/Zaloguj</wsa:Action>"
Soap = Soap & "<wsa:To>https://wyszukiwarkaregon.stat.gov.pl/wsBIR/UslugaBIRzewnPubl.svc</wsa:To>"
Soap = Soap & "</soap:Header><soap:Body><ns:Zaloguj><ns:pKluczUzytkownika>" & My_Key & "</ns:pKluczUzytkownika></ns:Zaloguj></soap:Body></soap:Envelope>"

Set objXml = CreateObject("MSXML2.ServerXMLHTTP.6.0")

'*********** Pobieramy numer sesji - SID połączenia, który wygasa po wywołaniu metody Wyloguj lub po upływie 60 minut.
With objXml
.Open "Post", sURL, False
.setRequestHeader "Content-Type", "application/soap+xml; charset=utf-8"
.send (Soap)

If .Status <> 200 Then
MsgBox Status_HTTP(.Status), vbCritical
Exit Sub
End If
Resp = .responseText

Dane = RegEx_Tab("<ZalogujResult>(.*?)<\/ZalogujResult>", Resp)

If Not IsArray(Dane) Then
MsgBox "Prawdopodobnie podałeś zły klucz API !", vbCritical
Exit Sub
End If

sID = Dane(0)
End With

Erase Dane

'*************** Pobieramy właściwe dane
For i = 2 To ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
With objXml
Nip = ws.Cells(i, 1).Value

'Koperta dla nip
Soap = "<soap:Envelope xmlns:soap=""http://www.w3.org/2003/05/soap-envelope"" xmlns:ns=""http://CIS/BIR/PUBL/2014/07"" xmlns:dat=""http://CIS/BIR/PUBL/2014/07/DataContract"">"
Soap = Soap & "<soap:Header xmlns:wsa=""http://www.w3.org/2005/08/addressing"">"
Soap = Soap & "<wsa:To>https://wyszukiwarkaregontest.stat.gov.pl/wsBIR/UslugaBIRzewnPubl.svc</wsa:To>"
Soap = Soap & "<wsa:Action>http://CIS/BIR/PUBL/2014/07/IUslugaBIRzewnPubl/DaneSzukajPodmioty</wsa:Action>"
Soap = Soap & "</soap:Header><soap:Body><ns:DaneSzukajPodmioty><ns:pParametryWyszukiwania><dat:Nip>" & Nip & "</dat:Nip></ns:pParametryWyszukiwania></ns:DaneSzukajPodmioty></soap:Body></soap:Envelope>"

.Open "Post", sURL, False
.setRequestHeader "Content-Type", "application/soap+xml; charset=utf-8"
.setRequestHeader "Sid", sID
.send (Soap)
Resp = Replace_Special_Char(.responseText)
End With

Resp = Replace(Resp, vbLf, "")
Dane = RegEx_Tab("<dane>(.*?)<\/dane>", Resp)
Dane(0) = "<dane>" & Dane(0) & "</dane>"

ws.Cells(i, 2).Value = FilterXMLData(Dane(0), "//Regon")
ws.Cells(i, 3).Value = FilterXMLData(Dane(0), "//Nazwa")
ws.Cells(i, 4).Value = FilterXMLData(Dane(0), "//Miejscowosc")
ws.Cells(i, 5).Value = FilterXMLData(Dane(0), "//Ulica")
ws.Cells(i, 6).Value = FilterXMLData(Dane(0), "//NrNieruchomosci")
ws.Cells(i, 7).Value = FilterXMLData(Dane(0), "//NrLokalu")
ws.Cells(i, 8).Value = FilterXMLData(Dane(0), "//KodPocztowy")
ws.Cells(i, 9).Value = FilterXMLData(Dane(0), "//MiejscowoscPoczty")
Next i

Set objXml = Nothing
Erase Dane

End Sub

Function RegEx_Tab(ByVal Pattern As String, ByVal Text As String) As Variant
Dim objRegEx As Object
Dim objMatches As Object
Dim objMatch As Object
Dim arrMatches() As Variant
Dim i As Long

Set objRegEx = CreateObject("VBScript.RegExp")
With objRegEx
.Global = True
.MultiLine = True
.IgnoreCase = True
.Pattern = Pattern
End With

If objRegEx.test(Text) Then
Set objMatches = objRegEx.Execute(Text)
ReDim arrMatches(0 To objMatches.Count - 1)

i = 0
For Each objMatch In objMatches
arrMatches(i) = objMatch.SubMatches(0)
i = i + 1
Next objMatch

RegEx_Tab = arrMatches
Else
RegEx_Tab = Empty
End If

Set objRegEx = Nothing
Set objMatches = Nothing
End Function

Function Replace_Special_Char(ByVal Text As String) As String
Replace_Special_Char = Replace(Text, "&", "&")
Replace_Special_Char = Replace(Replace_Special_Char, ">", ">")
Replace_Special_Char = Replace(Replace_Special_Char, "<", "<")
Replace_Special_Char = Replace(Replace_Special_Char, """, """")
Replace_Special_Char = Replace(Replace_Special_Char, "'", "'")
End Function

Function FilterXMLData(ByVal XMLData As String, ByVal XPath As String) As Variant
Dim xmlDoc As Object
Dim nodeList As Object
Dim node As Object
Dim result As Variant
Dim i As Long

Set xmlDoc = CreateObject("MSXML2.DOMDocument")
xmlDoc.SetProperty "SelectionLanguage", "XPath"
xmlDoc.async = False
xmlDoc.LoadXML XMLData

Set nodeList = xmlDoc.SelectNodes(XPath)

If nodeList.Length > 0 Then
ReDim result(0 To nodeList.Length - 1)
i = 0 ' Dodana deklaracja i inicjalizacja zmiennej i
For Each node In nodeList
result(i) = node.Text
i = i + 1
Next node
End If

FilterXMLData = result
End Function

Function Status_HTTP(ByVal StatusCode As Long) As String
Select Case StatusCode
Case 400
Status_HTTP = "Bad Request (Błąd żądania)"
Case 401
Status_HTTP = "Unauthorized (Nieautoryzowany)"
Case 403
Status_HTTP = "Forbidden (Zabronione)"
Case 404
Status_HTTP = "Not Found (Nie znaleziono)"
Case 500
Status_HTTP = "Internal Server Error (Wewnętrzny błąd serwera)"
Case Else
Status_HTTP = "Nieznany błąd HTTP"
End Select
End Function

Marecki · Wysłany: 05-07-2023, 12:11

Ad 1.

Wygląda na to, że funkcja FilterXML próbuje rozpoznać daty w danych XML, których dotyczy zapytanie, i konwertuje dane XML, zanim dane zostaną wysłane do komórki.
Nie możemy również zmienić formatu argumentu Xpath , więc nie możemy kontrolować danych wyjściowych.
Jednym z rozwiązań może być delikatna zmiana XML-a zanim trafi do funkcji.

W kodzie po instrukcji

Kod:

Resp = Replace(Resp, vbLf, "")

dopisz jeszcze to:

Kod:

Resp = Replace(Resp, "<NrNieruchomosci>", "<NrNieruchomosci>'")

FilterXML taki zapis 12/14 rozpoznaje jako datę i dlatego dochodzi do niejawnej konwersji.
Liczba 45274 to data 14.12.2023

Ad. 2
W pliku GUS_v2 umieściłem 2 kody
1. wersja testowa , która ma ograniczenia
2 wersja Produkcyjna , która nie ma ograniczeń - no chyba że API w jakiś sposób to ogranicza, nie wczytywałem się w to za bardzo.
Aby korzystać z wersji Produkcyjnej konieczne jest wpisanie do kodu poprawnego klucza

Kod:

Const My_Key As String = "xxxxxxxxxxxxxxx" 'Tu wpisz swój klucz z GUS-u

partner2001 · Exceloholic Wersja: Win Office 365 Posty: 239

Witaj Marecki.
A jak zmodyfikowć ten kod aby procedura pobierała tylko dane które sa puste. Pobieranie wszystkich danych w przypadku dużej liczby podmiotów jest czasochłonne. Czy można ominąc pobieranie juz pobranych danych?

Tajan · **Pomógł:** 5548 razy Posty: 12042

Po linii:

Kod:

For i = 2 To Arkusz1.Cells(Arkusz1.Rows.Count, 1).End(xlUp).Row

wstaw:

Kod:

If Not Arkusz1.Cells(i, 2).Value = "" Then

a dalej, przed linią:

Kod:

Next i

wstaw

Kod:

End If

To spowoduje, że dla wierszy w których kolumna REGON jest wypełniona, kod nie zostanie wykonany.

partner2001 · Exceloholic Wersja: Win Office 365 Posty: 239

Wstawiłem kody tak jak podałeś, ale po wstawieniu procedura wogóle nie pobiera danych.
Kod po wstawieniu wygląda tak

Kod:

Option Explicit

Sub Pobierz_Dane()
Const My_Key As String = "f7e002aed99345298833" 'Tu wpisz swój klucz z GUS-u
Const sURL As String = "https://wyszukiwarkaregon.stat.gov.pl/wsBIR/UslugaBIRzewnPubl.svc"
Dim objXml As Object
Dim Soap As String
Dim sID As Variant
Dim Resp As String
Dim Nip As String
Dim i As Long
Dim Dane As Variant

'Koperta do logowania
Soap = Soap & "<soap:Envelope xmlns:soap=""http://www.w3.org/2003/05/soap-envelope"" xmlns:ns=""http://CIS/BIR/PUBL/2014/07""> <soap:Header xmlns:wsa=""http://www.w3.org/2005/08/addressing"">"
Soap = Soap & "<wsa:Action>http://CIS/BIR/PUBL/2014/07/IUslugaBIRzewnPubl/Zaloguj</wsa:Action>"
Soap = Soap & "<wsa:To>https://wyszukiwarkaregon.stat.gov.pl/wsBIR/UslugaBIRzewnPubl.svc</wsa:To>"
Soap = Soap & "</soap:Header><soap:Body><ns:Zaloguj><ns:pKluczUzytkownika>" & My_Key & "</ns:pKluczUzytkownika></ns:Zaloguj></soap:Body></soap:Envelope>"

Set objXml = CreateObject("MSXML2.ServerXMLHTTP.6.0")

'*********** Pobieramy numer sesji - SID połączenia, który wygasa po wywołaniu metody Wyloguj lub po upływie 60 minut.
With objXml

.Open "Post", sURL, False
.setRequestHeader "Content-Type", "application/soap+xml; charset=utf-8"
.send (Soap)

If .Status <> 200 Then
MsgBox Status_HTTP(.Status), vbCritical
Exit Sub
End If
Resp = .responsetext

Dane = RegEx_Tab("<ZalogujResult>(.*?)<\/ZalogujResult>", Resp)

If Not IsArray(Dane) Then
MsgBox "Prawdopodobnie podałeś zły klucz API !", vbCritical
Exit Sub
End If

sID = Dane(0)
End With

Erase Dane

'*************** Pobieramy właściwe dane
For i = 2 To Arkusz9.Cells(Arkusz9.Rows.Count, 1).End(xlUp).Row
If Not Arkusz9.Cells(i, 2).Value = "" Then
With objXml
Nip = Arkusz9.Cells(i, 1).Value

'Koperta dla nip
Soap = "<soap:Envelope xmlns:soap=""http://www.w3.org/2003/05/soap-envelope"" xmlns:ns=""http://CIS/BIR/PUBL/2014/07"" xmlns:dat=""http://CIS/BIR/PUBL/2014/07/DataContract"">"
Soap = Soap & "<soap:Header xmlns:wsa=""http://www.w3.org/2005/08/addressing"">"
Soap = Soap & "<wsa:To>https://wyszukiwarkaregontest.stat.gov.pl/wsBIR/UslugaBIRzewnPubl.svc</wsa:To>"
Soap = Soap & "<wsa:Action>http://CIS/BIR/PUBL/2014/07/IUslugaBIRzewnPubl/DaneSzukajPodmioty</wsa:Action>"
Soap = Soap & "</soap:Header><soap:Body><ns:DaneSzukajPodmioty><ns:pParametryWyszukiwania><dat:Nip>" & Nip & "</dat:Nip></ns:pParametryWyszukiwania></ns:DaneSzukajPodmioty></soap:Body></soap:Envelope>"

.Open "Post", sURL, False
.setRequestHeader "Content-Type", "application/soap+xml; charset=utf-8"
.setRequestHeader "Sid", sID
.send (Soap)
Resp = Replace_Special_Char(.responsetext)
End With

Resp = Replace(Resp, vbLf, "")
Resp = Replace(Resp, "<NrNieruchomosci>", "<NrNieruchomosci>'")
Dane = RegEx_Tab("<dane>(.*?)<\/dane>", Resp)
Dane(0) = "<dane>" & Dane(0) & "</dane>"

With Application
Cells(i, 2).Value = .FilterXML(Dane(0), "//Regon")
Cells(i, 3).Value = .FilterXML(Dane(0), "//Nazwa")
Cells(i, 4).Value = .FilterXML(Dane(0), "//Miejscowosc")
Cells(i, 5).Value = .FilterXML(Dane(0), "//Ulica")
Cells(i, 6).Value = .FilterXML(Dane(0), "//NrNieruchomosci")
Cells(i, 7).Value = .FilterXML(Dane(0), "//NrLokalu")
Cells(i, 8).Value = .FilterXML(Dane(0), "//KodPocztowy")
Cells(i, 9).Value = .FilterXML(Dane(0), "//MiejscowoscPoczty")
End With
End If
Next i

Set objXml = Nothing
Erase Dane

End Sub