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

partner2001 · Exceloholic Wersja: Win Office 365 Posty: 239

Z lini

Kod:

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

usunęłem słowo Not tak, że linia wygląda tak

Kod:

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

i zadziałało.
Oczywiście w moim arkuszy zamieniłem Arkusz1 na Arkusz9 bo Ankusz9 pobiera dane.

Serdeczne dzięki Marecki i Tajan. Jak zwykle jesteści "The Best".

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

gosuansa · Świeżak Wersja: Win Office 365 Posty: 1

Auditorius, Cześć chciałbym pobrać ten twój kod do pobierania danych firmy po NIP (kod PKD i inne), ale nie moge tego pliku sciągnąc, czy masz go gdzieś jeszcze zapisanego, jesli tak to mogłbyś podesłac?
Byłbym ogromnie wdzięczny za pomoc

Pzdr
Robert

andro · Wysłany: 16-02-2024, 12:39

Pozwolę sobie na podpięcie. Czy mógłby ktoś udostępnić bieżący plik?, będę bardzo wdzięczny

psxx · Świeżak Wersja: Win Office 365 Posty: 6

Cześć,
odświeżę trochę temat.
Bazując na pliku przykładowym, do którego znajduje się w dokumentacji z API REGON oraz na pliku Mareckiego próbuję wykonać kod, który po numerze REGON zwróci mi następujące dane:
-nazwa firmy
-NIP
-ulica, numer lokalu, kod pocztowy, miejscowość
-PKD
Zmusić kod żeby pobierał dane po REGON zamiast po NIP jest bardzo prosto, jednak kiedy pobieram dane po REGON nie wiem jak mogę pobrać NIP; tak jakby nie było takiej danej w pobranym xml.
Jak to ogarnąć?
Jestem laikiem to widać, uczę się dopiero VBA :)

Marecki · Wysłany: 16-03-2024, 13:57 **GUS PKD REGON NIP**

Jeszcze raz :-)

Będą 3 części:
1. Pobieramy Nip z Regonu
2. Pobieramy Regon z NIP-u
3. Pobieramy PKD z Regonu

Uwaga - poniższe kody nie zawierają obsługi błędu, tzn nie sprawdzam statusu odpowiedzi z serwera czy Status=200, czy też nie.
Nie biorę pod uwagę przepełnienia przy dużej ilości zapytań - a to jest ograniczone - czytaj instrukcję -> https://api.stat.gov.pl/Home/RegonApi
Nie poddaje walidacji numeru NIP, czy też Regonu.
Otrzymujecie czysty kod , który działa i będzie działał dopóki GUS nie zmieni nic w sowim API.

Przyjąłem że posiadamy Key API nadany nam przez GUS, który musimy podstawić do kodu do stałej Key_Api

Część pierwsza *** Nip z Regonu ***

Kod:

Option Explicit

Const Key_Api As String = "xxxxxxxxxxxxxxxx" ' Tu wstaw swój klucz Api z GUS-u
Const sUrl As String = "https://wyszukiwarkaregon.stat.gov.pl/wsBIR/UslugaBIRzewnPubl.svc"

Sub Test1()
Dim Regon As Variant 'Variant, bo czasami posiadany numer Regon-u jest tekstem, a czasami liczbą.

Regon = "610188201" 'Tu dla przykładu "ORLEN"

MsgBox Nip_z_Regonu(Regon, Key_Api, sUrl), vbInformation
End Sub

Function Nip_z_Regonu(Regon As Variant, Key_Api As String, sUrl As String)
Dim objXml As Object
Dim Soap As String
Dim Sid As String * 20 'Tu przyjąlem, że ten numer zawsze będzie miał 20 znaków, czy słusznie-okaże się w testach. :-)
Dim Resp As String
Dim sRegon As String

'Koperta SOAP do wysłania na server w celu pobrania numeru SID
Soap = "<soap:Envelope xmlns:soap=""http://www.w3.org/2003/05/soap-envelope"" xmlns:ns=""http://CIS/BIR/PUBL/2014/07"">"
Soap = Soap & "<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 = Soap & "<soap:Body>"
Soap = Soap & "<ns:Zaloguj>"
Soap = Soap & "<ns:pKluczUzytkownika>" & Key_Api & "</ns:pKluczUzytkownika>"
Soap = Soap & "</ns:Zaloguj>"
Soap = Soap & "</soap:Body>"
Soap = Soap & "</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)
Sid = Split(.responsetext, "<ZalogujResult>")(1)

' Powyższy kod, czyli wyciągnięcie samego numeru sesji "SID"
' przy dużej ilości zapytań można wyciągnąć do oddzielnej funkcji,
' bo wiemy, że nie zmieni się on przez co najmniej 60 min.
',więc nie ma sensu wykonywać każdorazowo takiego zapytania.

'Koperta Soap dla NIP-u
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:Regon>" & Regon & "</dat:Regon></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)
'Tu z odpowiedzi otrzymamy nie tylko NIP,na którym nam zależy, ale też takie dane jak:
'- StatusNip
'- Nazwa
'- Wojewodztwo
'- Powiat
'- Gmina
'- Miejscowosc
'- KodPocztowy
'- Ulica
'- NrNieruchomosci, itd, itd....
End With

Set objXml = Nothing

sRegon = Split(Resp, "<Nip>")(1)
sRegon = Split(sRegon, "</Nip>")(0)
Nip_z_Regonu = sRegon

End Function

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

Część druga *** Regon z NIP-u ***

Kod:

Option Explicit

Const Key_Api As String = "xxxxxxxxxxxxxxxxx" ' Tu wstaw swój klucz Api z GUS-u
Const sUrl As String = "https://wyszukiwarkaregon.stat.gov.pl/wsBIR/UslugaBIRzewnPubl.svc"

Sub Test()
Dim Nip As Variant 'Variant, bo czasami posiadany numer NIP-u jest tekstem, a czasami liczbą.
Nip = "7740001454" 'Tu dla przykładu "ORLEN"
MsgBox Regon_z_Nip(Nip, Key_Api, sUrl), vbInformation
End Sub

Function Regon_z_Nip(Nip As Variant, Key_Api As String, sUrl As String)
Dim objXml As Object
Dim Soap As String
Dim Sid As String * 20 'Tu przyjąlem, że ten numer zawsze będzie miał 20 znaków, czy słusznie-okaże się w testach. :-)
Dim Resp As String
Dim sRegon As String

'Koperta SOAP do wysłania na server w celu pobrania numeru sesji SID
Soap = "<soap:Envelope xmlns:soap=""http://www.w3.org/2003/05/soap-envelope"" xmlns:ns=""http://CIS/BIR/PUBL/2014/07"">"
Soap = Soap & "<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 = Soap & "<soap:Body>"
Soap = Soap & "<ns:Zaloguj>"
Soap = Soap & "<ns:pKluczUzytkownika>" & Key_Api & "</ns:pKluczUzytkownika>"
Soap = Soap & "</ns:Zaloguj>"
Soap = Soap & "</soap:Body>"
Soap = Soap & "</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)
Sid = Split(.responsetext, "<ZalogujResult>")(1)

' Powyższy kod, czyli wyciągnięcie samego numeru sesji "SID"
' przy dużej ilości zapytań można wyciągnąć do oddzielnej funkcji,
' bo wiemy, że nie zmieni się on przez co najmniej 60 min.
',więc nie ma sensu wykonywać każdorazowo takiego zapytania.

'Koperta Soap dla Nip-u
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)
'Tu z odpowiedzi otrzymamy nie tylko Regon,na którym nam zależy, ale też takie dane jak:
'- StatusNip
'- Nazwa
'- Wojewodztwo
'- Powiat
'- Gmina
'- Miejscowosc
'- KodPocztowy
'- Ulica
'- NrNieruchomosci, itd, itd....
End With

Set objXml = Nothing

sRegon = Split(Resp, "<Regon>")(1)
sRegon = Split(sRegon, "</Regon>")(0)
Regon_z_Nip = sRegon

End Function

Część trzecia *** PKD z Regonu ***
Zauważmy że w części trzeciej doszła funkcja Raport.
Za jej pomocą możemy zmienić "rodzaj" pobieranych danych, niekoniecznie musi to być PKD.
Możemy pobrać np. listę jednostek lokalnych (np. oddziałów firmy) zarejestrowanych dla osoby prawnej.

Kod:

Option Explicit

Const Key_Api As String = "xxxxxxxxxxxxxxxx" ' Tu wstaw swój klucz Api z GUS-u
Const sUrl As String = "https://wyszukiwarkaregon.stat.gov.pl/wsBIR/UslugaBIRzewnPubl.svc"

Sub Test_PKD()
Dim Regon As Variant 'Variant, bo czasami posiadany numer Regon-u jest tekstem, a czasami liczbą.

Regon = "610188201" 'Tu dla przykładu "ORLEN"

MsgBox "PKD:" & vbNewLine & PKD_z_Regonu(Regon, Key_Api, sUrl, 6), vbInformation
End Sub

Function PKD_z_Regonu(Regon As Variant, Key_Api As String, sUrl As String, Nazwa_Raportu As Byte)
Dim objXml As Object
Dim Soap As String
Dim Sid As String * 20 'Tu przyjąlem, że ten numer zawsze będzie miał 20 znaków, czy słusznie-okaże się w testach. :-)
Dim Resp As String
Dim PKD As String
Dim i As Long
Dim vTmp As Variant

'Koperta SOAP do wysłania na server w celu pobrania numeru SID
Soap = "<soap:Envelope xmlns:soap=""http://www.w3.org/2003/05/soap-envelope"" xmlns:ns=""http://CIS/BIR/PUBL/2014/07"">"
Soap = Soap & "<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 = Soap & "<soap:Body>"
Soap = Soap & "<ns:Zaloguj>"
Soap = Soap & "<ns:pKluczUzytkownika>" & Key_Api & "</ns:pKluczUzytkownika>"
Soap = Soap & "</ns:Zaloguj>"
Soap = Soap & "</soap:Body>"
Soap = Soap & "</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)
Sid = Split(.responsetext, "<ZalogujResult>")(1)

' Powyższy kod, czyli wyciągnięcie samego numeru sesji "SID"
' przy dużej ilości zapytań można wyciągnąć do oddzielnej funkcji,
' bo wiemy, że nie zmieni się on przez co najmniej 60 min.
',więc nie ma sensu wykonywać każdorazowo takiego zapytania.

'Koperta Soap dla PKD
Soap = "<soap:Envelope xmlns:soap=""http://www.w3.org/2003/05/soap-envelope"" xmlns:ns=""http://CIS/BIR/PUBL/2014/07"">"
Soap = Soap & "<soap:Header xmlns:wsa=""http://www.w3.org/2005/08/addressing"">"
Soap = Soap & "<wsa:Action>http://CIS/BIR/PUBL/2014/07/IUslugaBIRzewnPubl/DanePobierzPelnyRaport</wsa:Action>"
Soap = Soap & "<wsa:To>https://wyszukiwarkaregontest.stat.gov.pl/wsBIR/UslugaBIRzewnPubl.svc</wsa:To>"
Soap = Soap & "</soap:Header>"
Soap = Soap & "<soap:Body>"
Soap = Soap & " <ns:DanePobierzPelnyRaport>"
Soap = Soap & " <ns:pRegon>" & Regon & "</ns:pRegon>"
Soap = Soap & " <ns:pNazwaRaportu>" & Raport(Nazwa_Raportu) & "</ns:pNazwaRaportu>"
Soap = Soap & " </ns:DanePobierzPelnyRaport>"
Soap = Soap & "</soap:Body>"
Soap = Soap & "</soap:Envelope>"
.Open "Post", sUrl, False
.setRequestHeader "Content-Type", "application/soap+xml; charset=utf-8"
.setRequestHeader "Sid", Sid
.send (Soap)
vTmp = VBA.Split(Replace_Special_Char(.responsetext), "<fiz_pkd_Kod>")
End With

Set objXml = Nothing

For i = 1 To UBound(vTmp)
PKD = PKD & ";" & Split(vTmp(i), "</fiz_pkd_Kod>")(0)
Next i

PKD_z_Regonu = PKD

End Function

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

Function Raport(Nr_raportu As Byte) As String

Select Case Nr_raportu
Case 1: Raport = "BIR11OsFizycznaDaneOgolne" 'Dane osoby fizycznej wspólne dla wszystkich prowadzonych przez nią działalności.
Case 2: Raport = "BIR11OsFizycznaDzialalnoscCeidg" 'Dane dot. działalności zarejestrowanej w CEIDG, w tym adres prowadzenia tej działalności.
Case 3: Raport = "BIR11OsFizycznaDzialalnoscRolnicza" 'Dane dot. działalności rolniczej; w tym adres prowadzenia działalności rolniczej.
Case 4: Raport = "BIR11OsFizycznaDzialalnoscPozostala" 'Dane dot. działalności innej niż z CEIDG i rolnicza (komornik, notariusz, agroturystyka) w tym adres prowadzenia działaln.
Case 5: Raport = "BIR11OsFizycznaDzialalnoscSkreslona" 'Dane dot. działalności skreślonej z REGON przed 2014.11.08 (tzn. w poprzednim systemie informatycznym)."
Case 6: Raport = "BIR11OsFizycznaPkd" 'Lista kodów PKD dla podmiotu osoby fizycznej"
Case 7: Raport = "BIR11OsFizycznaListaJednLokalnych" 'Lista jednostek lokalnych (np. oddziałów firmy) zarejestrowanych dla podmiotu osoby fizycznej"
Case 8: Raport = "BIR11JednLokalnaOsFizycznej" 'Dane jednostki lokalnej podmiotu osoby fizycznej"
Case 9: Raport = "BIR11JednLokalnaOsFizycznejPkd" 'Lista kodów PKD dla jednostki lokalnej podmiotu osoby fizycznej"
Case 10: Raport = "BIR11OsPrawna" 'Dane osoby prawnej; Uwaga: raporty dla osoby prawnej dot. także spółki cywilnej, która formalnie osobą prawną nie jest."
Case 11: Raport = "BIR11OsPrawnaPkd" 'Lista kodów PKD dla podmiotu osoby prawnej"
Case 12: Raport = "BIR11OsPrawnaListaJednLokalnych" 'Lista jednostek lokalnych (np. oddziałów firmy) zarejestrowanych dla osoby prawnej"
Case 13: Raport = "BIR11JednLokalnaOsPrawne" 'Dane jednostki lokalnej podmiotu osoby prawnej"
Case 14: Raport = "BIR11JednLokalnaOsPrawnejPkd" 'Lista kodów PKD dla jednostki lokalnej podmiotu osoby prawnej"
Case 15: Raport = "BIR11OsPrawnaSpCywilnaWspolnicy" 'Lista wspólników spółki cywilnej (tylko i wyłącznie S.C.) Uwaga: REGON prowadzi rejestrację wspólników od r.2012. (Dla spółek powstałych przed r.2012 i nieaktualizowanych - brak jest w REGON danych o wspólnikach)."
Case 16: Raport = "BIR11TypPodmiotu" 'Informacja o typie podmiotu (osoba fizyczna / prawna; jednostka lokalna os. fizycznej/ os. prawej)"
End Select

End Function

The end

psxx · Świeżak Wersja: Win Office 365 Posty: 6

bardzo Ci dziękuję, dużo mi to pomogło.
posklejałem to u siebie w pliku excela docelowym i śmiga fajnie :clap

Weebmg · Świeżak Wersja: Win Office 365 Posty: 1

Dzień dobry,

tak się zastanawiam czy w pobieraniu danych po nr NIP jest szansa uzyskać również nr KRS jeżeli firma taki posiada?

Marecki · Wysłany: 26-04-2024, 08:38 **KRS po NIP**

*** KRS po NIP ***

Kod:

Sub KRS_po_NIP()
Dim Param As String
Dim xmlHttp As Object
Dim Resp As String
Dim NIP As String

NIP = "7740001454"

Param = "{""rejestr"":[""P"",""S""],""podmiot"":{""krs"":null,""nip"":""" & NIP & """}}"

Set xmlHttp = CreateObject("MSXML2.XMLHTTP.6.0")

With xmlHttp
.Open "POST", "https://prs-openapi2-prs-prod.apps.ocp.prod.ms.gov.pl/api/wyszukiwarka/krs", False
.setRequestHeader "Content-Type", "application/json"
.Send (Param)

Select Case .Status
Case 200
Resp = .ResponseText
If VBA.Left$(Resp, 20) = "{""liczbaPodmiotow"":0" Then
Resp = "Podmiot nie znaleziony"
Else
Resp = "KRS : " & Split(VBA.Split(Resp, "numer"":""")(1), """")(0)
End If
Case 400
Resp = "Podmiot nie znaleziony"
Case Else
Resp = "Błąd usługi"
End Select

End With

Set xmlHttp = Nothing
MsgBox Resp, vbInformation

End Sub

*** KRS po REGON ***

Kod:

Sub KRS_po_Regon()
Dim Param As String
Dim xmlHttp As Object
Dim Resp As String
Dim Regon As String

Regon = "290513140"
If VBA.Len(Regon) = 9 Then Regon = Regon & "00000"

Param = "{""rejestr"":[""P"",""S""],""podmiot"":{""regon"":""" & Regon & """}}"

Set xmlHttp = CreateObject("MSXML2.XMLHTTP.6.0")

With xmlHttp
.Open "POST", "https://prs-openapi2-prs-prod.apps.ocp.prod.ms.gov.pl/api/wyszukiwarka/krs", False
.setRequestHeader "Content-Type", "application/json"
.Send (Param)

Select Case .Status
Case 200
Resp = .ResponseText
If VBA.Left$(Resp, 20) = "{""liczbaPodmiotow"":0" Then
Resp = "Podmiot nie znaleziony"
Else
Resp = "KRS : " & Split(VBA.Split(Resp, "numer"":""")(1), """")(0)
End If
Case 400
Resp = "Podmiot nie znaleziony"
Case Else
Resp = "Błąd usługi"
End Select

End With

Set xmlHttp = Nothing
MsgBox Resp, vbInformation

End Sub

Uwaga:
Regony składają się z 7-dmiu,9-ciu lub 14-stu cyfr.
Siedmio cyfrowymi się nie zajmowałem, nie szukałem takich w sieci żeby przetestować działanie kodu.
Dziewięcio cyfrowe - z tego co zauważyłem to należy dodać do nich 5 zer na końcu, aczkolwiek czy to jest regułą tego nie wiem.
Czternasto cyfrowe powinny działać.
Testujcie mając na uwadze powyższy opis.

Artik · Wysłany: 27-04-2024, 00:11