Voor mij was het eind 2022 nieuw, maar 'Universal Business Language' (UBL) is eigenlijk een hele mooie standaard om digitaal facturen te verwerken in plaats van de boekhouder iedere maand maar weer eindeloos de informatie op de PDF-factuur met de hand over te laten nemen.

Voorbeeld van een UBL factuur in XML formaat, in plaats van klassieke PDF:

Hieronder stukjes VBA waarmee factuur en factuurregels uit de database worden verwerkt tot bovenstaand XML bestand. Alle IXMLDOMElementen met de hand definieren was even werk, maar dat was eenmalig en kan nu snel hergebruikt worden. Disclaimer: code snippets niet volledig. Voor meer informatie


     

  Public Function nieuw_element(dom As MSXML2.DOMDocument60, _
                                 waaraan, _
                                 Naam As String, Optional text As String) As IXMLDOMElement
    
    '-- 20100517 gemaakt door Jelle
    Set nieuw_element = dom.createElement(Naam)
    If text <> "" Then
        nieuw_element.text = text
    End If
    waaraan.appendChild nieuw_element
    
End Function
Disclaimer: code niet volledig. Voor meer informatie

Public Function ap_efactuur_as_xml(factuurnummer As String) As String
'-- 2022.08.19 (obv Jelle 2010)(zie ap_XML_Maak)
    
    Dim db As DAO.Database
    Dim rsSupp As DAO.Recordset, rsl As DAO.Recordset, rsw As DAO.Recordset
    Dim rsInv As DAO.Recordset, rsInvLine As DAO.Recordset, rsCust As DAO.Recordset, rsO As DAO.Recordset
   
   Dim i As Integer, s As String, DebNr As String, orderid As Long
    Dim OrderNR As String
    Dim sPad As String, sfile As String, sSaveAs As String, factuurdatum As String
On Error GoTo foutafhandeling:

    Dim dom As MSXML2.DOMDocument60
    Set dom = New MSXML2.DOMDocument60
    
    Dim eExact As IXMLDOMElement
    Dim eInvoice As IXMLDOMElement
    
    Dim strExactElem As String
   
    Dim invoice As IXMLDOMElement
  '  Dim cbc As IXMLDOMElement
    Dim order As IXMLDOMElement
    Dim CurrencyElem As IXMLDOMElement
    Dim OrderedBy As IXMLDOMElement
    Dim Debtor As IXMLDOMElement
    Dim DeliverTo As IXMLDOMElement
    Dim InvoiceTo As IXMLDOMElement
    Dim PostalAddress As IXMLDOMElement
    
    Dim InvoiceLine As IXMLDOMElement
    Dim SalesOrderNo As IXMLDOMElement
    Dim LineYourRef As IXMLDOMElement
    Dim description As IXMLDOMElement
    Dim Item As IXMLDOMElement
    Dim Quantity As IXMLDOMElement
    Dim price  As IXMLDOMElement
    Dim PriceValue  As IXMLDOMElement
    Dim ValueElem  As IXMLDOMElement
    Dim Amount  As IXMLDOMElement
    Dim Delivery As IXMLDOMElement
   
    Dim Leverancier As IXMLDOMElement
    
    Dim AccountingSupplierParty As IXMLDOMElement
    Dim Party As IXMLDOMElement
    Dim PartyName As IXMLDOMElement
    Dim PartyTaxScheme As IXMLDOMElement
    Dim PartyIdentification As IXMLDOMElement
    
    
    
    
    Dim Id As IXMLDOMElement
    Dim elName As IXMLDOMElement
    Dim elCountry As IXMLDOMElement
    'Dim cac As IXMLDOMElement
    Dim PaymentMeansCode As IXMLDOMElement
    Dim FinancialInstitutionBranch As IXMLDOMElement
    Dim FinancialInstitution As IXMLDOMElement
    
    Dim sDescription As String
    
    Dim DateLastModified As Date
    Dim getal As Double
    Dim BTW_perc As Double
  ' Dim factuurnummer As String
    
  
    '-- HEADER
    '   
    
    Set invoice = nieuw_element(dom, dom, "Invoice")
    
    invoice.setAttribute "xmlns:cac", "urn:oasis:names:specification:ubl:schema:xsd:CommonAggregateComponents-2"
    invoice.setAttribute "xmlns:cbc", "urn:oasis:names:specification:ubl:schema:xsd:CommonBasicComponents-2"
    invoice.setAttribute "xmlns:ext", "urn:oasis:names:specification:ubl:schema:xsd:CommonExtensionComponents-2"
    invoice.setAttribute "xmlns:xsd", "http://www.w3.org/2001/XMLSchema"
    invoice.setAttribute "xmlns", "urn:oasis:names:specification:ubl:schema:xsd:Invoice-2"
    invoice.setAttribute "xmlns:xsi", "http://www.w3.org/2001/XMLSchema-instance"
    
    
    nieuw_element dom, invoice, "cbc:UBLVersionID", "2.0"
    nieuw_element dom, invoice, "cbc:CustomizationID", "urn:www.cenbii.eu:transaction:biicoretrdm010:ver1.0:#urn:www.peppol.eu:bis:peppol4a:ver1.0#urn:www.simplerinvoicing.org:si-ubl:invoice:ver1.0.x"
    nieuw_element dom, invoice, "cbc:ProfileID", "urn:www.cenbii.eu:profile:bii04:ver1.0"
    '-- 2022.09.27
        
    '--------------------------------------------------------------------------------------------------------------------------
    '   NAW GEGEVENS KLANT OPHALEN
    Set db = CurrentDb
    Set rsO = db.OpenRecordset("SELECT * FROM tbl_facturen WHERE factuurnummer = '" & factuurnummer & "'", dbOpenDynaset, dbSeeChanges)
    DebNr = Nz(rsO!debnr_klant, "?")
    OrderNR = Nz(rsO!ordernummer, "?")
    orderid = Nz(rsO!orderid, "?")
    
    If DebNr = "?" Then
        MsgBox "Kan Geen UBL factuurmaken", vbCritical, "Kan debnr niet lezen"
        Exit Function
    Else
        Set rsCust = db.OpenRecordset("SELECT * FROM organisatie WHERE ID='" & DebNr & "'", dbOpenDynaset, dbSeeChanges)
        Set rsInv = db.OpenRecordset("SELECT * FROM tbl_facturen WHERE ordernummer ='" & OrderNR & "'", dbOpenDynaset, dbSeeChanges)
    End If
   ' factuurnummer = rsInv!factuurnummer
    factuurdatum = Format(rsInv!factuurdatum, "yyyy-mm-dd")
    '----------------------------------------------------------------------------------------------------------------------------
    
    
    nieuw_element dom, invoice, "cbc:ID", factuurnummer  ' "20221067"   '=factuurnummer
    nieuw_element dom, invoice, "cbc:IssueDate", factuurdatum
    
       

Disclaimer: code snippets niet volledig. Voor meer informatie
Set AccountingSupplierParty = nieuw_element(dom, invoice, "cac:AccountingSupplierParty")
    Set Party = nieuw_element(dom, AccountingSupplierParty, "cac:Party")
    Set PartyIdentification = nieuw_element(dom, Party, "cac:PartyIdentification")
    
    ' -------------------------------------------------------
    Set db = CurrentDb
    Set rsSupp = db.OpenRecordset("SELECT * FROM tbl_UBL_AccountingSupplierParty WHERE ID=1", dbOpenDynaset, dbSeeChanges)
    Set Id = nieuw_element(dom, PartyIdentification, "cbc:ID")
    Id.text = rsSupp!BTW
    Id.setAttribute "schemeAgencyName", "BTW"
    
    Set PartyName = nieuw_element(dom, Party, "cac:PartyName")
    nieuw_element dom, PartyName, "cbc:Name", rsSupp!Name
    
    '   
    Set PostalAddress = nieuw_element(dom, Party, "cac:PostalAddress")
    nieuw_element dom, PostalAddress, "cbc:StreetName", rsSupp!streetname
    nieuw_element dom, PostalAddress, "cbc:BuildingNumber", rsSupp!BuildingNumber
    nieuw_element dom, PostalAddress, "cbc:Cityname", rsSupp!Cityname
    nieuw_element dom, PostalAddress, "cbc:Postalzone", rsSupp!Postalzone
        Set elCountry = nieuw_element(dom, PostalAddress, "cac:country")
        nieuw_element dom, elCountry, "cbc:IdentificationCode", rsSupp!LandCode
    Set PartyTaxScheme = nieuw_element(dom, Party, "cac:PartyTaxScheme")
    ' ------------------------------------------------
       

        Set PayableAmount = nieuw_element(dom, LegalMonetaryTotal, "cbc:PayableAmount", formatBedrag(rsInv!factuurtotaal))
    PayableAmount.setAttribute "Currency", "EUR"
    '---------------------------------------------------------------------------------------------------------------
    
    
    '-- 2022.06.09  INVOICELINES (HE HE wat een voorwerk..)
    Dim InvoicedQuantity As IXMLDOMElement
    
    Dim Percent As IXMLDOMElement
    Dim priceamount As IXMLDOMElement
    Dim Name As IXMLDOMElement, SellersItemIdentification As IXMLDOMElement
    Dim btw_code As Integer, btw_bedrag As String
    Dim bedrag As Double, sBedrag As String
    
    btw_code = rsInv!btw_code
    BTW_perc = DLookup("btw_percentage", "tbl_kde_btw", "btw_code= " & btw_code)
    Set rsInvLine = db.OpenRecordset("SELECT * FROM TBL_order_regel WHERE orderid=" & orderid & " order by posnr", dbOpenDynaset, dbSeeChanges)
    
    While Not rsInvLine.EOF
        
        Set InvoiceLine = nieuw_element(dom, invoice, "cac:InvoiceLine")
        
        Set Id = nieuw_element(dom, InvoiceLine, "cbc:ID", rsInvLine!posnr)
        
        Set InvoicedQuantity = nieuw_element(dom, InvoiceLine, "cbc:InvoicedQuantity", rsInvLine!somgeleverd)
        InvoicedQuantity.setAttribute "unitCode", "EA"
        
        Set LineExtensionAmount = nieuw_element(dom, InvoiceLine, "cbc:LineExtensionAmount")
        LineExtensionAmount.setAttribute "Currency", "EUR"
        LineExtensionAmount.text = formatBedrag(rsInvLine!Verkoopprijs * rsInvLine!somgeleverd)

     Set TaxTotal = nieuw_element(dom, InvoiceLine, "cac:TaxTotal")
                
                Set TaxAmount = nieuw_element(dom, TaxTotal, "cbc:TaxTotal")    'Prijs per stuk ExBTW
                TaxAmount.setAttribute "Currency", "EUR"
                TaxAmount.text = formatBedrag(rsInvLine!somgeleverd * rsInvLine!Verkoopprijs * BTW_perc / 100)
                
                Set TaxSubtotal = nieuw_element(dom, TaxTotal, "cbc:TaxSubtotal")
                    
                    Set TaxableAmount = nieuw_element(dom, TaxSubtotal, "cbc:TaxSubtotal")
                    TaxableAmount.setAttribute "Currency", "EUR"
                    TaxableAmount.text = formatBedrag(rsInvLine!Verkoopprijs * rsInvLine!somgeleverd)
                    
                    Set TaxAmount = nieuw_element(dom, TaxSubtotal, "cbc:TaxTotal")
                    TaxAmount.setAttribute "Currency", "EUR"
                    TaxAmount.text = formatBedrag(rsInvLine!somgeleverd * rsInvLine!Verkoopprijs * BTW_perc / 100)
                    
                    Set Taxcategory = nieuw_element(dom, TaxSubtotal, "cac:TaxCategory")
                        nieuw_element dom, Taxcategory, "cbc:ID", "S"
                        nieuw_element dom, Taxcategory, "cbc:Percent", CStr(BTW_perc) ' jaar 2022 = 21%
                        Set Taxscheme = nieuw_element(dom, Taxcategory, "cac:TaxScheme")
                            nieuw_element dom, Taxscheme, "cbc:ID", "VAT"
                            
            Set Item = nieuw_element(dom, InvoiceLine, "cac:Item")
                Set Name = nieuw_element(dom, Item, "cbc:Name", rsInvLine!ArtikelOmschrijving)
                Set SellersItemIdentification = nieuw_element(dom, Item, "cac:SellersItemIdentification")
                    nieuw_element dom, SellersItemIdentification, "cbc:ID", rsInvLine!ArtikelNr
            
            Set price = nieuw_element(dom, InvoiceLine, "cac:Price")
                Set priceamount = nieuw_element(dom, price, "cbc:PriceAmount")
                priceamount.setAttribute "Currency", "EUR"
                priceamount.text = formatBedrag(rsInvLine!Verkoopprijs)
        
        rsInvLine.MoveNext
    Wend
    rsInvLine.Close

    
    sfile = "efactuur_" & factuurnummer & ".XML"
    sPad = ap_XML_InitFolder(DebNr)
    sSaveAs = sPad & sfile
   
    If GetFileAttributes(sSaveAs) <> -1 Then
        Kill sSaveAs
    End If
    
    'Create the SAX reader.
    Dim rdr As New SAXXMLReader60
    'Create the XML writer.
    Dim wrt As New MXXMLWriter60
    
    Dim stream As New ADODB.stream
    stream.Charset = "UTF-8"
    stream.Type = adTypeText
    stream.Open
    
    'Set properties on the XML writer.
    wrt.output = stream
    
    stream.WriteText "" & vbCrLf
        
    ' wrt.byteOrderMark = True
    wrt.omitXMLDeclaration = True
    wrt.Encoding = "UTF-8"
    wrt.Version = "1.0"
    wrt.Indent = True
    wrt.byteOrderMark = False
    
    'Set the XML writer to the SAX content handler.
    Set rdr.contentHandler = wrt
    Set rdr.dtdHandler = wrt
    Set rdr.ErrorHandler = wrt
    rdr.putProperty "http://xml.org/sax/properties/lexical-handler", wrt
    rdr.putProperty "http://xml.org/sax/properties/declaration-handler", wrt
    'Parse the DOMDocument object.
    rdr.Parse dom
    
    stream.SaveToFile sSaveAs
    
    ap_efactuur_as_xml = sSaveAs
    
 ' Application.FollowHyperlink sSaveAs

exit_here:
    
    SysCmd acSysCmdSetStatus, "..."
    Screen.MousePointer = 0
    Exit Function
    
foutafhandeling:
    MsgBox Err.description
    GoTo exit_here

End Function
Public Function ap_XML_InitFolder(DebNr As String) As String
    
    '-- 2022.08.26 ------------
    Dim sOutputFolder As String, s As String
    sOutputFolder = "S:\DATABASE\XML\" ' DLookup("waarde", "variabele", "ID=7")
    
    If Right(sOutputFolder, 1) <> "\" Then sOutputFolder = sOutputFolder & "\"
    
    If InStr(1, CurrentProject.Name, "test") > 1 Then
        sOutputFolder = sOutputFolder & "TEST\"
    End If
    
    
    sOutputFolder = sOutputFolder & CStr(DebNr) & "\"
    
  
    'bestaat pas al
    If GetFileAttributes(sOutputFolder) <> -1 Then
        ap_XML_InitFolder = sOutputFolder
        Exit Function
    End If
    'nee, maak hem
    j = 0
    For i = 1 To Len(sOutputFolder)
        If Mid(sOutputFolder, i, 1) = "\" Then
            s = Left(sOutputFolder, i)
            If GetFileAttributes(s) = -1 Then
                MkDir s
            End If
        End If
        j = j + 1
    Next i

    If GetFileAttributes(sOutputFolder) <> -1 Then
        ap_XML_InitFolder = sOutputFolder
    Else
        ap_XML_InitFolder = "nOK"
    End If
  
 End Function