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.zip

Pobierz Plik ściągnięto 22 raz(y) 32.55 KB

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

Super sprawa, dzięki!

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

Auditorius · Exceloholic Wersja: Win Office 2013 Posty: 185

@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 9 raz(y) 273.68 KB

Soap_DaneSzukajPodmioty.txt

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

Gus_test.xlsm

Pobierz Plik ściągnięto 9 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 15 raz(y) 611 Bajtów

jarekkk · Exceloholic Posty: 172

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.