Übertragung der fertigen XML per VBA über das Webservice - Der Code

    • Übertragung der fertigen XML per VBA über das Webservice - Der Code

      Hallo

      Anbei mein Code zum Uploade der bereits fertigen XML-Datei an den Bund:

      Dieser teil kommt in ein Klassenmodul (ich habe es klmod_webservice_upload genannt)

      Quellcode

      1. Option Compare Database
      2. Option Explicit
      3. Dim dateiname As String
      4. Dim datei_basis As String ' Basisconstruct ohne Rechnunghsdaten
      5. Dim rechnung As String ' Rechnung welche in das basiskonstrukt condiert inetgriert wird
      6. Dim rechnung_b64 As String ' die Base64 codierte Rechnung
      7. Dim rechnung_fertig As String ' Das Construkt mit der base64 codierten Rechnung
      8. Dim sURL As String
      9. Dim antwort As String
      10. '
      11. Public Function upload(dateiname_ As String)
      12. dateiname = dateiname_
      13. upload_vorbereiten
      14. abschicken
      15. upload = antwort
      16. End Function
      17. Private Sub abschicken()
      18. Dim xmlHTP As New MSXML2.XMLHTTP60
      19. antwort = ""
      20. With xmlHTP
      21. .Open "POST", sURL, False
      22. .setRequestHeader "Content-Type", "text/xml; charset=utf-8"
      23. .setRequestHeader "SOAPAction", "http://erb.eproc.brz.gv.at/ws/documentupload/20121205/wsupload/uploadDocumentRequest"
      24. .send rechnung_fertig
      25. antwort = .responseText
      26. End With
      27. End Sub
      28. Private Sub upload_vorbereiten()
      29. Dim base As New klmod_base64
      30. rechnung = CreateObject("Scripting.FileSystemObject").opentextfile(dateiname).readall ' einlesen der vorbereiteten XML Datei
      31. rechnung_b64 = base.encode(rechnung) ' hier wird die Rechnung in BASE64 codiert
      32. rechnung_fertig = Replace(datei_basis, "$BASE64$", rechnung_b64) ' Die codierte Rechnung in die Vorlage kopieren
      33. End Sub
      34. Private Sub Class_Initialize()
      35. datei_basis = "R:\IT\Auswertungen\Bund_Verrechnung\basisconstuct_2.xml" ' muß angepasst werden, wo auch immer die Datei mit dem basiskonstruk liegt
      36. datei_basis = CreateObject("Scripting.FileSystemObject").opentextfile(datei_basis).readall
      37. sURL = "https://txm.portal.at/at.gv.bmf.erb/V2"
      38. End Sub
      Alles anzeigen









      Hier das Klassenmodul klmod_base64 welches die Rechnung codiert.
      Dieser Code stammt selbst aus dem Internet, der ist nicht von mir.

      Quellcode

      1. Option Compare Database
      2. Option Explicit
      3. Private encodeARR(64) As String * 1
      4. Private decodeARR(255) As Byte
      5. Private Const EncChars = _
      6. "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
      7. Property Get encode(strIn As String) As String
      8. Dim strOut As String, A(2) As Byte
      9. Dim N0 As Long, N1 As Long, N2 As Long, N3 As Long
      10. Dim Ausg As Long, i As Long, j As Long
      11. strOut = ""
      12. i = 1: Ausg = 3
      13. Do While i <= Len(strIn)
      14. For j = 0 To 2
      15. If i <= Len(strIn) Then
      16. A(j) = Asc(Mid(strIn, i, 1)): i = i + 1
      17. Else
      18. A(j) = 0: Ausg = Ausg - 1
      19. End If
      20. Next j
      21. N0 = (A(0) \ 4) And &H3F
      22. N1 = ((A(0) * 16) And &H30) + ((A(1) \ 16) And &HF)
      23. N2 = ((A(1) * 4) And &H3C) + ((A(2) \ 64) And &H3)
      24. N3 = A(2) And &H3F
      25. strOut = strOut & encodeARR(N0) & encodeARR(N1) & _
      26. IIf(Ausg > 1, encodeARR(N2), "=") & IIf(Ausg > 2, encodeARR(N3), "=")
      27. Loop
      28. encode = strOut
      29. End Property
      30. Property Get decode(strIn As String) As String
      31. Dim strOut As String
      32. Dim A0 As Long, A1 As Long, A2 As Long, A3 As Long
      33. Dim B0 As Long, B1 As Long, B2 As Long, B3 As Long
      34. Dim i As Long
      35. strOut = ""
      36. For i = 1 To Len(strIn) - 3 Step 4
      37. B0 = Asc(Mid$(strIn, i, 1)): A0 = decodeARR(B0)
      38. B1 = Asc(Mid$(strIn, i + 1, 1)): A1 = decodeARR(B1)
      39. B2 = Asc(Mid$(strIn, i + 2, 1)): A2 = decodeARR(B2)
      40. B3 = Asc(Mid$(strIn, i + 3, 1)): A3 = decodeARR(B3)
      41. strOut = strOut & Chr(((A0 * 4) Or (A1 \ 16)) And &HFF)
      42. If B2 <> Asc("=") Then strOut = strOut & Chr(((A1 * 16) Or (A2 \ 4)) And &HFF)
      43. If B3 <> Asc("=") Then strOut = strOut & Chr(((A2 * 64) Or A3) And &HFF)
      44. Next i
      45. decode = strOut
      46. End Property
      47. Private Sub Class_Initialize()
      48. Dim i As Long, ch As String
      49. For i = 0 To 255: decodeARR(i) = 0: Next i
      50. For i = 1 To Len(EncChars)
      51. ch = Mid(EncChars, i, 1)
      52. encodeARR(i - 1) = ch
      53. decodeARR(Asc(ch)) = i - 1
      54. Next i
      55. End Sub
      Alles anzeigen







      Aufgerufen wird das dann von einem Modul oder einem Form:

      Quellcode

      1. Dim ws As New klmod_webservice_upload
      2. antwort = ws.upload(akt_dateiname_komplett)
      3. bzw. wenn in einer Schleife, wo vor und nach dem Upload das File noch umbenannt wird:
      4. !! Ein File bei mir heißt z.b.: [i]ebinterface_4557006000_8451675041_163e1_vba.xml[/i]
      5. !! Das muß natürlich alles angepasst werden, nur mal als Idee der code
      6. Private Sub but_files_hochladen_Click()
      7. Dim dateiname As String
      8. Dim akt_dateiname_komplett As String
      9. Dim okay As Boolean
      10. Dim antwort As String
      11. Dim ws As New klmod_webservice_upload
      12. dateiname = Dir(pfad_xml)
      13. While dateiname <> ""
      14. If Left(dateiname, 11) = "ebinterface" Then
      15. okay = True
      16. If InStr(dateiname, "..") > 0 Then okay = False
      17. If okay Then
      18. txt_status = "upload " & dateiname
      19. DoEvents
      20. antwort = ""
      21. akt_dateiname_komplett = pfad_xml & "in_arbeit_" & dateiname
      22. Name pfad_xml & dateiname As akt_dateiname_komplett
      23. antwort = ws.upload(akt_dateiname_komplett)
      24. If InStr(antwort, "<Success>") > 0 Then ' <== nicht getestet, da beim ersten massenupload alles gut ging
      25. Name akt_dateiname_komplett As pfad_xml & "uploaded_" & dateiname
      26. Else
      27. MsgBox "no SUCCESS" & vbCrLf & "please contact your Hero"
      28. Stop
      29. End If
      30. End If
      31. End If
      32. dateiname = Dir()
      33. Wend
      34. End Sub
      Alles anzeigen






      Hier das basisconstuct_2.xml
      Username und Passwort muß hier das eigene eingetragen werden.

      XML-Quellcode

      1. <?xml version="1.0" encoding="utf-8"?>
      2. <env:Envelope xmlns:enc="http://schemas.xmlsoap.org/soap/encoding/"
      3. xmlns:env="http://schemas.xmlsoap.org/soap/envelope/"
      4. xmlns:wsse="http://docs.oasis-open.org/wss/2004/01/oasis-200401-wss-wssecurity-secext-1.0.xsd"
      5. xmlns:xsd="http://www.w3.org/2001/XMLSchema/">
      6. <env:Header>
      7. <wsse:Security>
      8. <wsse:UsernameToken>
      9. <wsse:Username>s000y0xxxxxx</wsse:Username>
      10. <wsse:Password>xxxxxxxxx</wsse:Password>
      11. </wsse:UsernameToken>
      12. </wsse:Security>
      13. </env:Header>
      14. <env:Body>
      15. <deliverInvoiceInvoiceInput xmlns="http://erb.eproc.brz.gv.at/ws/invoicedelivery/201306/">
      16. <Invoice encoding="UTF-8">$Base64$</Invoice>
      17. <!-- Die Base64-codierte e-Rechnung mit dem Originalzeichensatz UTF-8: -->
      18. </deliverInvoiceInvoiceInput>
      19. </env:Body>
      20. </env:Envelope>
      Alles anzeigen

      Dieser Beitrag wurde bereits 4 mal editiert, zuletzt von Roland ()