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)
Code
Option Compare Database
Option Explicit
Dim dateiname As String
Dim datei_basis As String ' Basisconstruct ohne Rechnunghsdaten
Dim rechnung As String ' Rechnung welche in das basiskonstrukt condiert inetgriert wird
Dim rechnung_b64 As String ' die Base64 codierte Rechnung
Dim rechnung_fertig As String ' Das Construkt mit der base64 codierten Rechnung
Dim sURL As String
Dim antwort As String
'
Public Function upload(dateiname_ As String)
dateiname = dateiname_
upload_vorbereiten
abschicken
upload = antwort
End Function
Private Sub abschicken()
Dim xmlHTP As New MSXML2.XMLHTTP60
antwort = ""
With xmlHTP
.Open "POST", sURL, False
.setRequestHeader "Content-Type", "text/xml; charset=utf-8"
.setRequestHeader "SOAPAction", "http://erb.eproc.brz.gv.at/ws/documentupload/20121205/wsupload/uploadDocumentRequest"
.send rechnung_fertig
antwort = .responseText
End With
End Sub
Private Sub upload_vorbereiten()
Dim base As New klmod_base64
rechnung = CreateObject("Scripting.FileSystemObject").opentextfile(dateiname).readall ' einlesen der vorbereiteten XML Datei
rechnung_b64 = base.encode(rechnung) ' hier wird die Rechnung in BASE64 codiert
rechnung_fertig = Replace(datei_basis, "$BASE64$", rechnung_b64) ' Die codierte Rechnung in die Vorlage kopieren
End Sub
Private Sub Class_Initialize()
datei_basis = "R:\IT\Auswertungen\Bund_Verrechnung\basisconstuct_2.xml" ' muß angepasst werden, wo auch immer die Datei mit dem basiskonstruk liegt
datei_basis = CreateObject("Scripting.FileSystemObject").opentextfile(datei_basis).readall
sURL = "https://txm.portal.at/at.gv.bmf.erb/V2"
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.
Code
Option Compare Database
Option Explicit
Private encodeARR(64) As String * 1
Private decodeARR(255) As Byte
Private Const EncChars = _
"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
Property Get encode(strIn As String) As String
Dim strOut As String, A(2) As Byte
Dim N0 As Long, N1 As Long, N2 As Long, N3 As Long
Dim Ausg As Long, i As Long, j As Long
strOut = ""
i = 1: Ausg = 3
Do While i <= Len(strIn)
For j = 0 To 2
If i <= Len(strIn) Then
A(j) = Asc(Mid(strIn, i, 1)): i = i + 1
Else
A(j) = 0: Ausg = Ausg - 1
End If
Next j
N0 = (A(0) \ 4) And &H3F
N1 = ((A(0) * 16) And &H30) + ((A(1) \ 16) And &HF)
N2 = ((A(1) * 4) And &H3C) + ((A(2) \ 64) And &H3)
N3 = A(2) And &H3F
strOut = strOut & encodeARR(N0) & encodeARR(N1) & _
IIf(Ausg > 1, encodeARR(N2), "=") & IIf(Ausg > 2, encodeARR(N3), "=")
Loop
encode = strOut
End Property
Property Get decode(strIn As String) As String
Dim strOut As String
Dim A0 As Long, A1 As Long, A2 As Long, A3 As Long
Dim B0 As Long, B1 As Long, B2 As Long, B3 As Long
Dim i As Long
strOut = ""
For i = 1 To Len(strIn) - 3 Step 4
B0 = Asc(Mid$(strIn, i, 1)): A0 = decodeARR(B0)
B1 = Asc(Mid$(strIn, i + 1, 1)): A1 = decodeARR(B1)
B2 = Asc(Mid$(strIn, i + 2, 1)): A2 = decodeARR(B2)
B3 = Asc(Mid$(strIn, i + 3, 1)): A3 = decodeARR(B3)
strOut = strOut & Chr(((A0 * 4) Or (A1 \ 16)) And &HFF)
If B2 <> Asc("=") Then strOut = strOut & Chr(((A1 * 16) Or (A2 \ 4)) And &HFF)
If B3 <> Asc("=") Then strOut = strOut & Chr(((A2 * 64) Or A3) And &HFF)
Next i
decode = strOut
End Property
Private Sub Class_Initialize()
Dim i As Long, ch As String
For i = 0 To 255: decodeARR(i) = 0: Next i
For i = 1 To Len(EncChars)
ch = Mid(EncChars, i, 1)
encodeARR(i - 1) = ch
decodeARR(Asc(ch)) = i - 1
Next i
End Sub
Alles anzeigen
Aufgerufen wird das dann von einem Modul oder einem Form:
Code
Dim ws As New klmod_webservice_upload
antwort = ws.upload(akt_dateiname_komplett)
bzw. wenn in einer Schleife, wo vor und nach dem Upload das File noch umbenannt wird:
!! Ein File bei mir heißt z.b.: [i]ebinterface_4557006000_8451675041_163e1_vba.xml[/i]
!! Das muß natürlich alles angepasst werden, nur mal als Idee der code
Private Sub but_files_hochladen_Click()
Dim dateiname As String
Dim akt_dateiname_komplett As String
Dim okay As Boolean
Dim antwort As String
Dim ws As New klmod_webservice_upload
dateiname = Dir(pfad_xml)
While dateiname <> ""
If Left(dateiname, 11) = "ebinterface" Then
okay = True
If InStr(dateiname, "..") > 0 Then okay = False
If okay Then
txt_status = "upload " & dateiname
DoEvents
antwort = ""
akt_dateiname_komplett = pfad_xml & "in_arbeit_" & dateiname
Name pfad_xml & dateiname As akt_dateiname_komplett
antwort = ws.upload(akt_dateiname_komplett)
If InStr(antwort, "<Success>") > 0 Then ' <== nicht getestet, da beim ersten massenupload alles gut ging
Name akt_dateiname_komplett As pfad_xml & "uploaded_" & dateiname
Else
MsgBox "no SUCCESS" & vbCrLf & "please contact your Hero"
Stop
End If
End If
End If
dateiname = Dir()
Wend
End Sub
Alles anzeigen
Hier das basisconstuct_2.xml
Username und Passwort muß hier das eigene eingetragen werden.
XML
<?xml version="1.0" encoding="utf-8"?>
<env:Envelope xmlns:enc="http://schemas.xmlsoap.org/soap/encoding/"
xmlns:env="http://schemas.xmlsoap.org/soap/envelope/"
xmlns:wsse="http://docs.oasis-open.org/wss/2004/01/oasis-200401-wss-wssecurity-secext-1.0.xsd"
xmlns:xsd="http://www.w3.org/2001/XMLSchema/">
<env:Header>
<wsse:Security>
<wsse:UsernameToken>
<wsse:Username>s000y0xxxxxx</wsse:Username>
<wsse:Password>xxxxxxxxx</wsse:Password>
</wsse:UsernameToken>
</wsse:Security>
</env:Header>
<env:Body>
<deliverInvoiceInvoiceInput xmlns="http://erb.eproc.brz.gv.at/ws/invoicedelivery/201306/">
<Invoice encoding="UTF-8">$Base64$</Invoice>
<!-- Die Base64-codierte e-Rechnung mit dem Originalzeichensatz UTF-8: -->
</deliverInvoiceInvoiceInput>
</env:Body>
</env:Envelope>
Alles anzeigen