Creating SEPA Files

I used Chilkat XML when working with XML, I have also used MS XML but find Chilkat better.

This code will create an SEPA XML file using the passed details in transaction and header recordsets.

I am reworking this into a sample Excel file for those who have a small volume of variable SEPA payments to create. This post will be updated with the sample when its tested.

Function MakeXML(tmpRunNo, tmpBank, tmpFirst As Boolean)
On Error GoTo Errorhandler

Dim success As Long

Dim xml As New ChilkatXml
Dim DDInst As ChilkatXml
Dim GroupHeader As ChilkatXml
Dim PaymentInformation As ChilkatXml
Dim DDTransactionInformation As ChilkatXml

'Group Header Fields
Dim MessageID As ChilkatXml
Dim MessageDateTime As ChilkatXml
Dim TotalNumberofPayments As ChilkatXml
Dim TotalValue As ChilkatXml
Dim InitiatingParty As ChilkatXml
Dim InitiatingPartyID As ChilkatXml
Dim InitiatingPartyOrgID As ChilkatXml
Dim InitiatingPartyOthr As ChilkatXml
Dim InitiatingPartyOthrId As ChilkatXml
Dim tmpLoop, tmpBIC, tmpIBAN, tmpBankName, tmpSignDate


'Payment Fields
Dim PaymentID As ChilkatXml
Dim PaymentMethod As ChilkatXml
Dim BatchBook As ChilkatXml
Dim NoofTrans  As ChilkatXml
Dim TransValue As ChilkatXml
Dim PaymentTypeInformation As ChilkatXml
Dim ServiceLevel As ChilkatXml
Dim ServiceLevelCode As ChilkatXml
Dim LocalInstrument As ChilkatXml
Dim LocalInstrumentCode As ChilkatXml
Dim SequenceTP As ChilkatXml
Dim RequestedCollectionDate As ChilkatXml
Dim Creditor As ChilkatXml
Dim CreditorName As ChilkatXml
Dim CreditorAccount As ChilkatXml
Dim CreditorID As ChilkatXml
Dim CreditorIBAN As ChilkatXml
Dim CreditorAgentBIC As ChilkatXml
Dim FinInstnId As ChilkatXml
Dim CreditorBIC As ChilkatXml
Dim PmtId As ChilkatXml
Dim PaymentEndToEndId As ChilkatXml
Dim InstructionAmount As ChilkatXml
Dim DDMandatetx As ChilkatXml
Dim MndtRltdInf As ChilkatXml
Dim MandateId As ChilkatXml
Dim MandateSignDate As ChilkatXml
Dim CdtrSchmeId As ChilkatXml
Dim CdtrSchmeIdID As ChilkatXml
Dim PrvtId As ChilkatXml
Dim Othr As ChilkatXml
Dim CreditorSEPAID As ChilkatXml
Dim CreditorSchmeNm As ChilkatXml
Dim CreditorPrtry As ChilkatXml
Dim CustomerAgent As ChilkatXml
Dim CustomerFinInstnId As ChilkatXml
Dim CustomerBIC As ChilkatXml
Dim Customer As ChilkatXml
Dim CustomerName As ChilkatXml
Dim CustomerAccount As ChilkatXml
Dim CustomerAccId As ChilkatXml
Dim CustomerIBAN As ChilkatXml

Dim PL_CdtrSchmeId As ChilkatXml
Dim PL_CdtrSchmeIdID As ChilkatXml
Dim PL_PrvtId As ChilkatXml
Dim PL_Othr As ChilkatXml
Dim PL_CreditorSEPAID As ChilkatXml
Dim PL_CreditorSchmeNm As ChilkatXml
Dim PL_CreditorPrtry As ChilkatXml



xml.Tag = "Document"
xml.addAttribute "xmlns", "urn:iso:std:iso:20022:tech:xsd:pain.008.001.02"

Set DDInst = xml.NewChild("CstmrDrctDbtInitn", "")

'Payment Group Information
Set GroupHeader = DDInst.NewChild("GrpHdr", "")
   
Set MessageID = GroupHeader.NewChild("MsgId", Format(Now(), "YYYYMMDDhhss") & "-" & Range("Payment_number").Value)

Set MessageDateTime = GroupHeader.NewChild("CreDtTm", Format(Date, "YYYY-MM-DD") & "T" & Format(Now(), "HH:mm:SS"))
Set TotalNumberofPayments = GroupHeader.NewChild("NbOfTxs", Range("NumberofPayments"))
Set TotalValue = GroupHeader.NewChild(" CtrlSum", Format(Range("PaymentValue"), "#.00"))
Set InitiatingParty = GroupHeader.NewChild("InitgPty", "") ' Sepa User ID
Set InitiatingPartyID = InitiatingParty.NewChild("Id", "")
If tmpBank = "AIB" Then
    Set InitiatingPartyOrgID = InitiatingPartyID.NewChild("OrgId", "")
    Set InitiatingPartyOthr = InitiatingPartyOrgID.NewChild("Othr", "")
    Set InitiatingPartyOthrId = InitiatingPartyOthr.NewChild("Id", Range("Sepa_UserID"))
ElseIf tmpBank = "BOI" Then
    Set InitiatingPartyOrgID = InitiatingPartyID.NewChild("PrvtId", "")
    Set InitiatingPartyOthr = InitiatingPartyOrgID.NewChild("Othr", "")
    Set InitiatingPartyOthrId = InitiatingPartyOthr.NewChild("Id", Range("Sepa_UserID"))
Else
    Set InitiatingPartyOrgID = InitiatingPartyID.NewChild("OrgId", "")
    Set InitiatingPartyOthr = InitiatingPartyOrgID.NewChild("Othr", "")
    Set InitiatingPartyOthrId = InitiatingPartyOthr.NewChild("Id", Range("Sepa_UserID"))
End If



   
Set PaymentInformation = DDInst.NewChild("PmtInf", "")
Set PaymentID = PaymentInformation.NewChild("PmtInfId", Right("00000" & Range("Payment_number"), 5))
Set PaymentMethod = PaymentInformation.NewChild("PmtMtd", "DD")
Set BatchBook = PaymentInformation.NewChild("BtchBookg", "true")
Set NoofTrans = PaymentInformation.NewChild("NbOfTxs", Range("Number_of_Payments"))
Set TransValue = PaymentInformation.NewChild("CtrlSum", Format(Range("Total_Payment_Value"), "#.00"))

Set PaymentTypeInformation = PaymentInformation.NewChild("PmtTpInf", "")
Set ServiceLevel = PaymentTypeInformation.NewChild("SvcLvl", "")
Set ServiceLevelCode = ServiceLevel.NewChild("Cd", "SEPA")
Set LocalInstrument = PaymentTypeInformation.NewChild("LclInstrm", "")
Set LocalInstrumentCode = LocalInstrument.NewChild("Cd", "CORE")
Set SequenceTP = PaymentTypeInformation.NewChild("SeqTp", rstTrans!Seq) 'FRST – for First presentation RCUR – for Recurrent presentation OOFF – for Once off presentation FNAL – for Final presenta
Set RequestedCollectionDate = PaymentInformation.NewChild("ReqdColltnDt", Format(rstTrans!CollectionDate, "YYYY-MM-DD"))
Set Creditor = PaymentInformation.NewChild("Cdtr", "")
Set CreditorName = Creditor.NewChild("Nm", rstHeader!SEPA_Name)
Set CreditorAccount = PaymentInformation.NewChild("CdtrAcct", "")
Set CreditorID = CreditorAccount.NewChild("Id", "")
Set CreditorIBAN = CreditorID.NewChild("IBAN", rstHeader!SEPA_IBAN)
Set CreditorAgentBIC = PaymentInformation.NewChild("CdtrAgt", "")
Set FinInstnId = CreditorAgentBIC.NewChild("FinInstnId", "")
Set CreditorBIC = FinInstnId.NewChild("BIC", rstHeader!SEPA_BIC)

'Set CdtrSchmeId = PaymentInformation.NewChild("CdtrSchmeId", "")
'Set CdtrSchmeIdID = CdtrSchmeId.NewChild("Id", "")
'Set PrvtId = CdtrSchmeIdID.NewChild("PrvtId", "")
'Set Othr = PrvtId.NewChild("Othr", "")
'Set CreditorSEPAID = Othr.NewChild("Id", "") 'rstHeader!SEPA_UserID) Line 47
'Set CreditorSchmeNm = Othr.NewChild("SchmeNm", "")
'Set CreditorPrtry = CreditorSchmeNm.NewChild("Prtry", "") '"SEPA")


'loop on payment
tmpLoop = Range("Start").Row + 1
Do While ActiveCell.Offset(tmpLoop, 0).Value <> ""
    If ActiveCell.Offset(tmpLoop, 4).Value <> 0 Then
        Set DDTransactionInformation = PaymentInformation.NewChild("DrctDbtTxInf", "")
        Set PmtId = DDTransactionInformation.NewChild("PmtId", "")
        Set PaymentEndToEndId = PmtId.NewChild("EndToEndId", Format(Now(), "YYYYMMDDhhss") & "T" & tmpLoop) ' must be unique
        Set InstructionAmount = DDTransactionInformation.NewChild("InstdAmt", Format(Round(ActiveCell.Offset(tmpLoop, 4).Value), "#.00"))
        InstructionAmount.addAttribute "Ccy", "EUR"
    
        Set DDMandatetx = DDTransactionInformation.NewChild("DrctDbtTx", "")
        Set MndtRltdInf = DDMandatetx.NewChild("MndtRltdInf", "")
        tmpMandateID = Application.WorksheetFunction.VLookup(ActiveCell.Offset(tmpLoop, 0), Range("Customers"), 4, False)
        Set MandateId = MndtRltdInf.NewChild("MndtId", tmpMandateID)
        tmpSignDate = Format(Application.WorksheetFunction.VLookup(ActiveCell.Offset(tmpLoop, 0), Range("Customers"), 6, False), "YYYY-MM-DD")
        Set MandateSignDate = MndtRltdInf.NewChild("DtOfSgntr", tmpSignDate)
       
        Set PL_CdtrSchmeId = DDMandatetx.NewChild("CdtrSchmeId", "")
        Set PL_CdtrSchmeIdID = PL_CdtrSchmeId.NewChild("Id", "")
        Set PL_PrvtId = PL_CdtrSchmeIdID.NewChild("PrvtId", "")
        Set PL_Othr = PL_PrvtId.NewChild("Othr", "")
        Set PL_CreditorSEPAID = PL_Othr.NewChild("Id", Range("Sepa_USer_ID"))
        Set PL_CreditorSchmeNm = PL_Othr.NewChild("SchmeNm", "")
        Set PL_CreditorPrtry = PL_CreditorSchmeNm.NewChild("Prtry", "SEPA")
       
       
        Set CustomerAgent = DDTransactionInformation.NewChild("DbtrAgt", "")
        Set CustomerFinInstnId = CustomerAgent.NewChild("FinInstnId", "")
        tmpBIC = 1
        Set CustomerBIC = CustomerFinInstnId.NewChild("BIC", tmpBIC)
       
        Set Customer = DDTransactionInformation.NewChild("Dbtr", "")
        Set CustomerName = Customer.NewChild("Nm", Replace(ActiveCell.Offset(tmpLoop, 1).Value, "&", "+"))
        Set CustomerAccount = DDTransactionInformation.NewChild("DbtrAcct", "")
        Set CustomerAccId = CustomerAccount.NewChild("Id", "")
        tmpIBAN = 2
        Set CustomerIBAN = CustomerAccId.NewChild("IBAN", tmpIBAN)
        'end loop on payment
    End If
    tmpLoop = tmpLoop + 1
Loop


success = xml.SaveXml(Range("ExportFileName"))
If (success <> 1) Then
    MsgBox xml.LastErrorText
Else
    MsgBox "File Created " & Range("ExportFileName")
End If


Exit Function

Errorhandler:
MsgBox "An Error Occurred creating the File " & Err.Number & " " & Err.Description


End Function