Wysyłka pliku xml do Ministerstwa Finansów
na przykładzie pit-37.
  strona główna:
A po co ten Excel ;-)
 
 
 
  Wiem… trochę późno ;-) ale cóż..  
 
Z jakiego programu excel'o-maniak korzysta przy rozliczeniu rocznym podatku?? :-)   
Ja też tak mam.. Korzystając z Excela składam pity już od lat. Gotowe wzory deklaracji (dla osób fizycznych  
 - za darmo!!) udostępnia serwis "Formularze podatkowe w Excelu pit.republika.pl". Mi się podobają :-)   
Niedawno nawiązałem kontakt z Janem Podedwornym, właścicielem serwisu, w sprawie pewnego udogodnienia   
:-) Efekt tych prac chciałbym dzisiaj opisać.  
Mianowicie: serwis udostępnia możliwość przesyłania pitów do Urzędu Skarbowego. Jednak sposób realizacji  
tego zadania był dwuetapowy: 1) na podstawie danych z deklaracji tworzony jest plik xml z danymi do  
przesłania. 2) używając Kreatora w formularzach podatkowych pdf Ministerstwa Finansów z zainstalowanym  
dodatkiem do Adobe Reader'a - należy zaimportować dane z naszego xml'a i wysłać do US.  
Powstało pytanie: czy da się przesyłać dane z deklaracji do US - bezpośrednio! ?? Okazuje się że TAK :-)  
Wersja 2.0 pitów za 2015 jest dostępna na stronce pit.republika.pl od 12.04.2016, a dziś opiszę Wam jak to działa.  
Ps: w serwisie pominięto tworzenie xml'a. Całość danych jest wysyłana ze zmiennej jednak ja w tym artykule będę bazował na takim    
pliku, ze względu na fakt, że będę publikował tylko te procedury, których jestem autorem.   Formularze podatkowe w Excelu
pit.republika.pl
 
Daną wejściową jest dla mnie plik xml będący efektem eksportu danych z pliku xls Pit-37 v22. Program zapisuje taki plik na ścieżce    
Thisworkbook.Path & "\…xml". Ścieżka ta zostaje zapisana do zmiennej: strXMLPath    
  PIT 2015 Wersja 2.0 z dnia 12.04.2016 r.
zawiera bezpośrednią wysyłkę zeznań do systemu e-Deklaracje
Całość zadania można podzielić na 4 etapy:  
1) Walidacja poprawności xml'a ze wzorcem xsd Ministerstwa Finansów  
2) Podpisanie xml'a - wersja podpisu: Dane Autoryzacyjne - przychód podatnika za poprzedni rok.  
3) Wysyłka podpisanego xml'a i pobranie numeru ref przesyłki.    
4) Pobranie UPO (Urzędowego Poświadczenie Odbioru) dokumentu.  
 
część 1:   
Walidacja poprawności xml'a ze wzorcem xsd Ministerstwa Finansów  
 
Pierwszym krokiem jest sprawdzenie poprawności pliku xml względem schematu xsd publikowanego przez Ministerstwo Finansów  
  MSXML VBA: Validating XML against XSD
stackoverflow.com
Function XSD_Validation(strXMLPIT37v22 As String) As Boolean  
    Dim xmlDoc As Object 'MSXML2.DOMDocument60  
    Dim objSchemaCache As Object 'New XMLSchemaCache60  
    Dim objErr As Object 'MSXML2.IXMLDOMParseError   Referencing XSD Schemas in Documents
msdn.microsoft.com
 
    Set objSchemaCache = CreateObject("MSXML2.XMLSchemaCache.6.0")  
    objSchemaCache.Add "http://crd.gov.pl/wzor/2016/01/05/3061/", _  
                       "http://crd.gov.pl/wzor/2016/01/05/3061/schemat.xsd"   Schematy xsd dokumentów
  http://www.finanse.mf.gov.pl/pp/e-deklaracje/struktury-dokumentow-xml
    Set xmlDoc = CreateObject("Msxml2.DOMDocument.6.0")  
    With xmlDoc  
        .setProperty "ProhibitDTD", False  
        .async = False  
        .validateOnParse = True  
        .resolveExternals = False  
        .Load strXMLPIT37v22  
        Set .Schemas = objSchemaCache  
    End With  
 
    Set objErr = xmlDoc.Validate()  
    If objErr.ErrorCode = 0 Then  
        MsgBox "Błędów nie znaleziono"  
        XSD_Validation = True  
    Else  
        MsgBox "Error parser: " & objErr.ErrorCode & "; " & objErr.reason  
    End If   Jeżeli w dalszej części artykułu podołuję się na "Specyfikację MF" to cytaty lub zdjęcia pochodzą z:
End Function  
 
część 2:   
Podpisanie xml'a - wersja podpisu: Dane Autoryzacyjne - przychód podatnika za poprzedni rok.  
  Specyfikacje Wejścia-Wyjścia
Podpisywanie xml'a zacząłem od porównania: czym różni się xml "nie podpisany" - wyjściowy, od "podpisanego". Korzystając z dotych-  
czasowego sposobu przesyłu deklaracji zapisałem xml'a z dodanym podpisem "Danymi Autoryzacyjnymi". Jaka jest różnica?   Specyfikacja We-Wy - środowisko testowe v.2.1 przedstawiająca zasady wymiany informacji pomiędzy środowiskiem testowym systemu informatycznego e-Deklaracje a testowanym oprogramowaniem interfejsowym przeznaczonym do przekazywania dokumentów do systemu e-Deklaracje (z dnia 1.03.2015 r.).
 
Okazuje się ze podpisany xml posiada <podp:DaneAutoryzujące> pod załącznikami.  
Dane autoryzacyjne mogą pochodzić wprost z pierwotnego pliku xml. Są to: PESEL/NIP; Pierwsze imię, Nazwisko, Data urodzenia.  
Dane dot. Kwoty przychodu należy dodać, u mnie stała przychod_2014 i zapisać w xml'u w formacie z . (kropka) jako separatorem  
dziesiętnym.  
 
 
 
 
 
 
 
 
 
 
 
 
 
 
Type Dane_Autoryzacji  
    strPesel As String  
    strImie As String  
    strNazwisko As String  
    strDataUr As String  
    strKwota As String  
End Type  
 
Const przychod_2014 As Double = 123.45  
 
Sub Podpisywanie(str_NiePodpisanyXML As String)  
    Dim t As Dane_Autoryzacji  
    Dim strDaneAut As String  
      
    t = CzytajDaneAutoryzacji_zXML(str_NiePodpisanyXML, Replace(przychod_2014, ",", "."))  
    strDaneAut = Node_DaneAutoryzujace(t)  
      
    Dodaj_DaneAutoryzacyjne str_NiePodpisanyXML, strDaneAut  
    MsgBox "Podpisano: " & str_NiePodpisanyXML  
 
End Sub  
 
Function CzytajDaneAutoryzacji_zXML(strXMLPath As String, _  
                                    strKwota As String) As Dane_Autoryzacji  
    Dim xmlDoc As Object  'MSXML2.DOMDocument  
    Dim oRoot As Object 'MSXML2.IXMLDOMNode  
    Dim colNodes As Object 'MSXML2.IXMLDOMNodeList  
    Dim oNode As Object 'MSXML2.IXMLDOMNode  
    Const strXPath As String = "//Deklaracja/Podmiot1/OsobaFizyczna"  
      
    CzytajDaneAutoryzacji_zXML.strKwota = strKwota  
 
    Set xmlDoc = CreateObject("MSXML2.DOMDocument")  
    With xmlDoc  
        .Load strXMLPath  
        Set oRoot = .DocumentElement  
        Set colNodes = oRoot.SelectNodes(strXPath)  
        For Each oNode In colNodes(0).ChildNodes  
            Select Case oNode.nodeName  
                Case "PESEL"  
                    CzytajDaneAutoryzacji_zXML.strPesel = oNode.nodeTypedValue  
                Case "ImiePierwsze"  
                    CzytajDaneAutoryzacji_zXML.strImie = oNode.nodeTypedValue  
                Case "Nazwisko"  
                    CzytajDaneAutoryzacji_zXML.strNazwisko = oNode.nodeTypedValue  
                Case "DataUrodzenia"  
                    CzytajDaneAutoryzacji_zXML.strDataUr = oNode.nodeTypedValue  
            End Select  
        Next  
    End With  
    Set xmlDoc = Nothing  
End Function  
 
Function Node_DaneAutoryzujace(danePodatkina As Dane_Autoryzacji) As String  
 
    Node_DaneAutoryzujace = _  
        "<podp:DaneAutoryzujace " & _  
              "xmlns:podp=""http://e-deklaracje.mf.gov.pl/Repozytorium/Definicje/Podpis/"">" & _  
        "<podp:PESEL>" & danePodatkina.strPesel & "</podp:PESEL>" & _  
        "<podp:ImiePierwsze>" & UT(danePodatkina.strImie) & "</podp:ImiePierwsze>" & _  
        "<podp:Nazwisko>" & UT(danePodatkina.strNazwisko) & "</podp:Nazwisko>" & _  
        "<podp:DataUrodzenia>" & danePodatkina.strDataUr & "</podp:DataUrodzenia>" & _  
        "<podp:Kwota>" & danePodatkina.strKwota & "</podp:Kwota></podp:DaneAutoryzujace>"  
 
End Function  
 
Sub Dodaj_DaneAutoryzacyjne(strXML, strDaneAutoryzacji As String)  
    Dim nr As Integer  
    Dim intFileLen As Integer, temp As String  
      
    nr = VBA.FreeFile  
    Open strXML For Input As #nr  
        temp = Input(LOF(nr), #nr)  
    Close #nr  
    temp = Replace(temp, vbCrLf, "")  
      
    nr = VBA.FreeFile  
    Open strXML For Output As #nr  
        Print #nr, temp  
    Close #nr  
      
    nr = VBA.FreeFile  
    Open strXML For Append As #nr  
        intFileLen = LOF(nr)  
        Seek nr, intFileLen - 14  
        Print #nr, strDaneAutoryzacji & "</Deklaracja>"  
    Close #nr  
      
End Sub  
 
Function UT(ByVal sStr As String)  
    Dim L As Long, lChar As Long, sUTF8 As String  
    For L = 1 To Len(sStr)  
        lChar = AscW(Mid(sStr, L&, 1))  
        If lChar < 128 Then  
            sUTF8 = sUTF8 + Mid(sStr, L, 1)  
        ElseIf ((lChar > 127) And (lChar < 2048)) Then  
            sUTF8 = sUTF8 + Chr(((lChar \ 64) Or 192))  
            sUTF8 = sUTF8 + Chr(((lChar And 63) Or 128))  
        Else  
            sUTF8 = sUTF8 + Chr(((lChar \ 144) Or 234))  
            sUTF8 = sUTF8 + Chr((((lChar \ 64) And 63) Or 128))  
            sUTF8 = sUTF8 + Chr(((lChar And 63) Or 128))  
        End If  
    Next L&  
    UT = sUTF8  
End Function  
 
"Dwa słowa"  
z elementów xml'a pierwotnego "//Deklaracja/Podmiot1/OsobaFizyczna" (xPath) do struktury t As Dane_Autoryzacji zapisuję:  
PESEL, ImiePierwsze, Nazwisko, DataUrodzenia czytając odpowiednie oNode.nodeName i zapisując ich wartości oNode.nodeTypedValue  
Kwotę Przychodów w strukturze t zapisuję wprost ze stałej.     CzytajDaneAutoryzacji_zXML.strKwota = strKwota  
 
Funkcja Function Node_DaneAutoryzujace(danePodatkina As Dane_Autoryzacji) As String ze struktury t zwraca cały brakujący ciąg  
Danych Autoryzacyjnych. Procedura: Sub Dodaj_DaneAutoryzacyjne(strXML, strDaneAutoryzacji As String) do pierwotnego pliku xml  
zapisuje element podpisu. ( i usuwa Entery - które okazały się zbędne na etapie wysyłki)  
 
część 3:   
Wysyłka podpisanego xml'a i pobranie numeru ref przesyłki.   SOAP Web Services Query in VBScript
gallery.technet.microsoft.com
 
Ten fragment byłby niewykonalny gdyby nie przykładowa procedura na stronce technet (z prawej) z przykładem dla VBS.  
Danych nt. specyfikacji wysyłki oraz przesyłanego pliku dostarcza Ministerstwo Finansów w Specyfikacji str.50 i poniżej  
 
 
 
 
Const sSoapAction = "https://test-bramka.edeklaracje.gov.pl/uslugi/dokumenty?wsdl"  
'Const sSoapAction = "https://bramka.edeklaracje.gov.pl/uslugi/dokumenty?wsdl"  
 
Const sWebServiceURL As String = "https://test-bramka.edeklaracje.gov.pl/uslugi/dokumenty/"  
'Const sWebServiceURL As String = "https://bramka.e-deklaracje.mf.gov.pl/uslugi/dokumenty"  
 
Const strChr As String = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"  
 
Function WysylkaXMLaPodpisanego(str_PodpisanyXML) As String  
    Dim strDoWysylki As String: strDoWysylki = DoWysylki(str_PodpisanyXML)  
 
    Dim xmlDoc As Object  'MSXML2.DOMDocument  
    Dim oRoot As Object 'MSXML2.IXMLDOMNode  
 
    Set xmlDoc = CreateObject("MSXML2.DOMDocument")  
    With xmlDoc  
      
        Dim strXPath As String, strNameSpaceURI As String  
        Dim oNodeParent As Object 'MSXML2.IXMLDOMNode  
        Dim oNode As Object 'MSXML2.IXMLDOMNode  
        Dim strInfo As String  
          
        strXPath = "//soapenv:Envelope/soapenv:Body/ns:sendUnsignDocumentResponse"  
        strNameSpaceURI = "xmlns:soapenv='http://schemas.xmlsoap.org/soap/envelope/' " & _  
                          "xmlns:ns='https://bramka.e-deklaracje.mf.gov.pl/xsd'"  
      
        Set xmlDoc = CreateObject("Msxml2.DOMDocument")  
        With xmlDoc  
            .async = False  
            .setProperty "SelectionLanguage", "XPath"  
            .setProperty "SelectionNamespaces", strNameSpaceURI  
              
            Dim strRequest As String: strRequest = Wysylka(strDoWysylki)  
            If Len(strRequest) = 0 Then Exit Function  
            Stop  
            .LoadXML strRequest  
            Set oRoot = .DocumentElement  
            Set oNodeParent = oRoot.SelectSingleNode(strXPath)  
            If Not oNodeParent Is Nothing Then  
                 
                For Each oNode In oNodeParent.ChildNodes  
                    If oNode.nodeName = "ns:refId" Then WysylkaXMLaPodpisanego = oNode.nodeTypedValue  
                    strInfo = strInfo & oNode.nodeName & vbTab & oNode.nodeTypedValue & vbNewLine  
                Next  
            Else  
                strInfo = oRoot.Text  
            End If  
        End With  
        MsgBox strInfo  
        Set xmlDoc = Nothing  
 
    End With  
    Set xmlDoc = Nothing  
          
End Function  
 
Function Wysylka(ByVal strTxtWysylki As String) As String  
    On Error GoTo Wysylka_Error  
    Dim oWinHttp As Object  
    Set oWinHttp = CreateObject("WinHttp.WinHttpRequest.5.1")  
      
    oWinHttp.Open "POST", sWebServiceURL, False  
    oWinHttp.setRequestHeader "SOAPAction", sSoapAction  
    oWinHttp.Send strTxtWysylki  
    Wysylka = oWinHttp.ResponseText  
      
Wysylka_Exit:  
    On Error Resume Next  
    Set oWinHttp = Nothing  
      
    Exit Function  
            
 
Wysylka_Error:  
     MsgBox "Błąd Nr - " & Err.Number & vbCrLf & vbCrLf & _  
            Err.Description, vbExclamation, "VBAProject - Wysylka"  
     Resume Wysylka_Exit  
End Function
 
 
Function DoWysylki(strXMLPath As String) As String  
    Dim strPlik As String  
      
    Dim nr As Integer: nr = VBA.FreeFile  
    Dim strBinFile As String  
              
    Open strXMLPath For Binary Access Read As nr  
        strBinFile = String(LOF(nr), " ")  
        Get nr, , strBinFile  
    Close nr  
    strBinFile = Right(strBinFile, Len(strBinFile) - 3)  
    strPlik = "<?xml version=""1.0"" encoding=""UTF-8""?>" & _  
              "<soapenv:Envelope xmlns:soapenv=""http://schemas.xmlsoap.org/soap/envelope/"" " & _  
                                "xmlns:xsd=""https://bramka.e-deklaracje.mf.gov.pl/xsd"">" & _  
              "<soapenv:Header/>" & _  
              "<soapenv:Body>" & _  
                "<xsd:sendUnsignDocument>" & _  
                  "<xsd:document>" & Base64_Koder(strBinFile) & "</xsd:document>" & _  
                "</xsd:sendUnsignDocument>" & _  
              "</soapenv:Body>" & _  
              "</soapenv:Envelope>"  
    DoWysylki = strPlik  
 
End Function  
 
'http://www.apocotenexcel.pl/base64.htm  
'---------------Koder-------------------------  
Function Base64_Koder(sText As String) As String  
    Dim i  
    Dim s8Bit As String, ii  
    Dim sWynik As String  
 
    For i = 1 To Len(sText)  
        s8Bit = s8Bit & Dec2Bin(Asc(Mid(sText, i, 1)), 8)  
    Next  
    If (Len(s8Bit) Mod 6) > 0 Then s8Bit = s8Bit & String(6 - (Len(s8Bit) Mod 6), "0")  
              
    For ii = 1 To Len(s8Bit) Step 6  
        sWynik = sWynik & Bit6NaZnak(Mid(s8Bit, ii, 6))  
    Next  
    If (Len(sWynik) Mod 4) > 0 Then sWynik = sWynik & String(4 - (Len(sWynik) Mod 4), "=")  
              
    Base64_Koder = sWynik  
End Function  
      
Function Bit6NaZnak(strBit6 As String) As String  
    Bit6NaZnak = Mid(strChr, Bin2Dec(strBit6) + 1, 1)  
End Function  
 
Function Bin2Dec(sMyBin As String) As Long  
    Dim x  
    Dim iLen  
              
    iLen = Len(sMyBin) - 1  
    For x = 0 To iLen  
        Bin2Dec = Bin2Dec + Mid(sMyBin, iLen - x + 1, 1) * 2 ^ x  
    Next  
End Function  
      
Function Dec2Bin(ByVal DecVal As Integer, bLen As Byte) As String  
    Dim sBin As String  
    Dim intLiczba: intLiczba = DecVal  
    Do  
        sBin = intLiczba Mod 2 & sBin  
        intLiczba = (intLiczba - (intLiczba Mod 2)) / 2  
    Loop While intLiczba > 0  
    Dec2Bin = String(bLen - Len(sBin), "0") & sBin  
End Function  
 
"dwa słowa":  
z str_PodpisanyXML funkcja WysylkaXMLaPodpisanego tworzy: strDoWysylki = DoWysylki(str_PodpisanyXML)  
Funkcja ta  
    Dim nr As Integer: nr = VBA.FreeFile  
    Dim strBinFile As String  
              
    Open strXMLPath For Binary Access Read As nr  
        strBinFile = String(LOF(nr), " ")  
        Get nr, , strBinFile  
    Close nr  
zapisuje do zmiennej strBinFile Binarną wersję podpisanego pliku xml.  
Wartość tej zmiennej koduje algorytmem base64. Opis funkcji na mojej stronce (link z prawej)   Kodowanie danych - base64
                  "<xsd:document>" & Base64_Koder(strBinFile) & "</xsd:document>" & _  
i tworzy cały ciąg przesyłki zgodnie z wzorcem ze Specyfikacji MF.  
Ten ciąg przesyłki zostaje przesłany funkcją: Wysyłka(strDoWysylki) która zwraca ciąg odpowiedzi strRequest. Wysyłka realizowana  
jest za pomocą obiektu..  
    Set oWinHttp = CreateObject("WinHttp.WinHttpRequest.5.1")
 
      
    oWinHttp.Open "POST", sWebServiceURL, False  
    oWinHttp.setRequestHeader "SOAPAction", sSoapAction  
    oWinHttp.Send strTxtWysylki  
    Wysylka = oWinHttp.ResponseText  
gdzie sWebServiceURL i sSoapAction to publiczne stałe - ze specyfikacji MF. Błąd na tym poziomie,   
przy wysyłce na "bramkę testową" oznacza brak zainstalowanego certyfikatu "root_minfin.cer" ale o tym   
później :-)  
Następnie trzeba przeanalizować odpowiedź. Zależało mi na wykorzystaniu obiektu Msxml2.DOMDocument  
dlatego tak skomplikowana procedura.  
        strXPath = "//soapenv:Envelope/soapenv:Body/ns:sendUnsignDocumentResponse"  
to element odpowiedzi "pod którym" znajdują się istotne dane ...  
        strNameSpaceURI = "xmlns:soapenv='http://schemas.xmlsoap.org/soap/envelope/' " & _
 
                          "xmlns:ns='https://bramka.e-deklaracje.mf.gov.pl/xsd'"  
chcąc używać prefiksów w xPath trzeba podać NameSpaceURI ;-)  
są w przykładowym ciągu odpowiedzi w Specyfikacji MF.  
 
reszta już prosta :-)  
        Set xmlDoc = CreateObject("Msxml2.DOMDocument")  
        With xmlDoc  
            .async = False  
            .setProperty "SelectionLanguage", "XPath"  
            .setProperty "SelectionNamespaces", strNameSpaceURI  
            .LoadXML strRequest  
            Set oRoot = .DocumentElement  
            Set oNodeParent = oRoot.SelectSingleNode(strXPath)  
            If Not oNodeParent Is Nothing Then  
                 
                For Each oNode In oNodeParent.ChildNodes  
                    If oNode.nodeName = "ns:refId" Then WysylkaXMLaPodpisanego = oNode.nodeTypedValue  
                    strInfo = strInfo & oNode.nodeName & vbTab & oNode.nodeTypedValue & vbNewLine  
                Next  
            Else  
                strInfo = oRoot.Text  
            End If  
        End With  
 
tu:  
                    If oNode.nodeName = "ns:refId" Then WysylkaXMLaPodpisanego = oNode.nodeTypedValue  
funkcji WysylkaXMLaPodpisanego = oNode.nodeTypedValue przypisany jest nrRef przesłanego dokumentu. Będzie potrzebny do   
pobrania UPO. Zapisuję go do nazwanej lokalizacji [refNr].  
 
 
 
część 4:   
Pobranie UPO (Urzędowego Poświadczenie Odbioru) dokumentu.  
 
Sub Potwierdzenie(Optional strRefNR)  
    If IsMissing(strRefNR) Then strRefNR = [refNR]  
    If Len(strRefNR) = 0 Then  
        MsgBox "Nie wysłane!!"  
        Exit Sub  
    End If  
      
    Dim strXPath As String, strNameSpaceURI As String  
    Dim strUPO As String: strUPO = HTML_Decode(requestUPO(strRefNR))  
    Dim xmlDoc As Object  'MSXML2.DOMDocument  
    Dim oRoot As Object 'MSXML2.IXMLDOMNode  
    Dim oNodeParent As Object 'MSXML2.IXMLDOMNode  
    Dim oNode As Object 'MSXML2.IXMLDOMNode  
      
    Dim strInfo As String  
      
    If (Len(strUPO) - Len(Replace(strUPO, "<?xml", ""))) / 5 = 1 Then  
        strXPath = "//soapenv:Envelope/soapenv:Body/ns:requestUPOResponse"  
        strNameSpaceURI = "xmlns:soapenv='http://schemas.xmlsoap.org/soap/envelope/' " & _  
                          "xmlns:ns='https://bramka.e-deklaracje.mf.gov.pl/xsd'"  
      
        Set xmlDoc = CreateObject("Msxml2.DOMDocument.6.0")  
        With xmlDoc  
            .async = False  
            .setProperty "SelectionLanguage", "XPath"  
            .setProperty "SelectionNamespaces", strNameSpaceURI  
              
            .LoadXML strUPO  
            Set oRoot = .DocumentElement  
            Set oNodeParent = oRoot.SelectSingleNode(strXPath)  
      
            For Each oNode In oNodeParent.ChildNodes  
                strInfo = strInfo & oNode.nodeName & vbTab & oNode.nodeTypedValue & vbNewLine  
            Next  
        End With  
        Set xmlDoc = Nothing  
    Else  
        Dim poz1 As Long: poz1 = InStr(strUPO, "<ns:upo>") + 8  
        Dim poz2 As Long: poz2 = InStr(strUPO, "</ns:upo>")  
        Dim strText As String: strText = Mid(strUPO, poz1, poz2 - poz1)  
          
        '---------pobranie statusu------------  
        Dim strStatus As String  
        strStatus = Mid(strUPO, InStr(strUPO, "<ns:status>") + 11, 3)  
 
        strInfo = strInfo & strStatus & vbNewLine  
        Dim pozS As Long: pozS = InStr(strUPO, "<ns:statusOpis>") + 15  
        strInfo = strInfo & Mid(strUPO, pozS, InStr(strUPO, "</ns:statusOpis>") - pozS) & vbNewLine  
      
        strXPath = "//ds:Signature/ds:Object/Potwierdzenie"  
                  '"//ds:Signature/ds:SignedInfo/ds:Reference/@Id"  
                                    
        strNameSpaceURI = "xmlns:ds='http://www.w3.org/2000/09/xmldsig#'"  
      
        Set xmlDoc = CreateObject("Msxml2.DOMDocument.6.0")  
        With xmlDoc  
            .async = False  
            .setProperty "SelectionLanguage", "XPath"  
            .setProperty "SelectionNamespaces", strNameSpaceURI  
              
            .LoadXML strText  
            Set oRoot = .DocumentElement  
            Set oNodeParent = oRoot.SelectSingleNode(strXPath)  
      
            For Each oNode In oNodeParent.ChildNodes  
                strInfo = strInfo & oNode.nodeName & vbTab & oNode.nodeTypedValue & vbNewLine  
            Next  
        End With  
        Set xmlDoc = Nothing  
    End If  
    MsgBox strInfo  
End Sub  
 
 
Function requestUPO(ByVal strRefID As String) As String  
    Dim oWinHttp As Object  
    Set oWinHttp = CreateObject("WinHttp.WinHttpRequest.5.1")  
      
    oWinHttp.Open "POST", sWebServiceURL, False  
    oWinHttp.setRequestHeader "SOAPAction", sSoapAction  
    oWinHttp.Send "<?xml version=""1.0"" encoding=""UTF-8""?>" & _  
                  "<soapenv:Envelope xmlns:soapenv=""http://schemas.xmlsoap.org/soap/envelope/"" " & _  
                                    "xmlns:xsd=""https://bramka.e-deklaracje.mf.gov.pl/xsd"">" & _  
                  "<soapenv:Header/>" & _  
                  "<soapenv:Body>" & _  
                    "<xsd:requestUPO>" & _  
                      "<xsd:refId>" & strRefID & "</xsd:refId>" & _  
                    "</xsd:requestUPO>" & _  
                  "</soapenv:Body>" & _  
                  "</soapenv:Envelope>"  
    requestUPO = oWinHttp.ResponseText  
      
    Set oWinHttp = Nothing  
      
End Function  
 
Function HTML_Decode(ByVal encodedstring)   vbscript create-convert xml with special characters
http://stackoverflow.com/
  Dim tmp, i  
  tmp = encodedstring  
  tmp = Replace(tmp, "&quot;", Chr(34))
 
  tmp = Replace(tmp, "&apos;", Chr(39))  
  tmp = Replace(tmp, "&lt;", Chr(60))  
  tmp = Replace(tmp, "&gt;", Chr(62))  
  tmp = Replace(tmp, "&amp;", Chr(38))  
  tmp = Replace(tmp, "&nbsp;", Chr(32))  
  For i = 160 To 255  
    tmp = Replace(tmp, "&#" & i & ";", Chr(i))  
  Next  
  HTML_Decode = tmp  
End Function  
 
 
"dwa słowa":  
Sub Potwierdzenie(Optional strRefNR)  
    If IsMissing(strRefNR) Then strRefNR = [refNR]  
    If Len(strRefNR) = 0 Then  
        MsgBox "Nie wysłane!!"  
        Exit Sub  
    End If  
 
Potwierdzenie może być wysłane tuż po otrzymaniu refNr i wtedy Procedura Potwierdzenie będzie wywoływana z parametrem, albo  
może być wywołana później. Wtedy refNR jest zapisywany do zmiennej strRefNr z lokalizacji [refNr].