Create a Sepa XML File
I use Chilkat XML to create the Sepa XML code as its more structured and easier to follow. You can also replicate this code in Microsoft XML. This example is used from an access database I will post a sample Excel file which is used to generate an XML file with the associated code.
To start you will need a header recordset which summarises the party being debited,the total value and number of transactions.
You can use this code to process you direct debits from Sage line 50 by taking the account balances from a given date. Connect to Sage using the ODBC connection to get the customer balances.
Function MakeXML(tmpRunNo, tmpBank, tmpFirst As Boolean)
On Error GoTo Errorhandler
Dim rst As Recordset
Dim success As Long, tmpSQL As String
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
'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
Dim rstHeader As Recordset
Dim rstTrans As Recordset
tmpSQL = "SELECT tblBank.OwnerID AS SEPA_UserID, tblBank.DBankName AS SEPA_Name, tblBank.DbankNumber AS SEPA_IBAN, tblBank.DbankCode AS SEPA_BIC, tblDDListing.DDRunNumber AS RunNo, Sum(roundcc(tblDDListing.Value)) AS DDTotal, Count(tblDDListing.CCode) AS TotalTrans, '" & [Forms]![frmDDCreate]![UFileLoc] & IIf(tmpFirst, "FIRST_", "RECURRING_") & [Forms]![frmDDCreate]![UFileName] & "' AS ExportFileName"
tmpSQL = tmpSQL & " FROM tblDDListing, tblBank"
tmpSQL = tmpSQL & " WHERE DDRunNumber=" & tmpRunNo
tmpSQL = tmpSQL & " AND TransCode='" & IIf(tmpFirst, "01", "17") & "'"
tmpSQL = tmpSQL & " GROUP BY tblBank.OwnerID, tblBank.DBankName, tblBank.DbankNumber, tblBank.DbankCode, tblDDListing.DDRunNumber, '" & [Forms]![frmDDCreate]![UFileLoc] & IIf(tmpFirst, "FRST_", "RCUR_") & [Forms]![frmDDCreate]![UFileName] & "'"
'Debug.Print tmpSQL
Set rstHeader = CurrentDb.OpenRecordset(tmpSQL)
If rstHeader.RecordCount = 0 Then
Set rstHeader = Nothing
Exit Function
End If
Set rstTrans = CurrentDb.OpenRecordset("qryTrans")
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") & "-" & rstHeader!RunNo)
Set MessageDateTime = GroupHeader.NewChild("CreDtTm", Format(Date, "YYYY-MM-DD") & "T" & Format(Now(), "HH:mm:SS"))
Set TotalNumberofPayments = GroupHeader.NewChild("NbOfTxs", rstHeader!TotalTrans)
Set TotalValue = GroupHeader.NewChild(" CtrlSum", Format(rstHeader!DDTotal, "#.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", rstHeader!SEPA_UserID)
ElseIf tmpBank = "BOI" Then
Set InitiatingPartyOrgID = InitiatingPartyID.NewChild("PrvtId", "")
Set InitiatingPartyOthr = InitiatingPartyOrgID.NewChild("Othr", "")
Set InitiatingPartyOthrId = InitiatingPartyOthr.NewChild("Id", rstHeader!SEPA_UserID)
Else
Set InitiatingPartyOrgID = InitiatingPartyID.NewChild("OrgId", "")
Set InitiatingPartyOthr = InitiatingPartyOrgID.NewChild("Othr", "")
Set InitiatingPartyOthrId = InitiatingPartyOthr.NewChild("Id", rstHeader!SEPA_UserID)
End If
Set PaymentInformation = DDInst.NewChild("PmtInf", "")
Set PaymentID = PaymentInformation.NewChild("PmtInfId", rstTrans!TransID)
Set PaymentMethod = PaymentInformation.NewChild("PmtMtd", "DD")
Set BatchBook = PaymentInformation.NewChild("BtchBookg", "true")
Set NoofTrans = PaymentInformation.NewChild("NbOfTxs", rstHeader!TotalTrans)
Set TransValue = PaymentInformation.NewChild("CtrlSum", Format(rstHeader!DDTotal, "#.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
Do While Not rstTrans.EOF
Set DDTransactionInformation = PaymentInformation.NewChild("DrctDbtTxInf", "")
Set PmtId = DDTransactionInformation.NewChild("PmtId", "")
Set PaymentEndToEndId = PmtId.NewChild("EndToEndId", Format(Now(), "YYYYMMDDhhss") & "T" & rstTrans!TransID) ' must be unique
Set InstructionAmount = DDTransactionInformation.NewChild("InstdAmt", Format(RoundCC(rstTrans!Amount), "#.00"))
InstructionAmount.AddAttribute "Ccy", "EUR"
Set DDMandatetx = DDTransactionInformation.NewChild("DrctDbtTx", "")
Set MndtRltdInf = DDMandatetx.NewChild("MndtRltdInf", "")
Set MandateId = MndtRltdInf.NewChild("MndtId", rstTrans!D_Bankname)
Set MandateSignDate = MndtRltdInf.NewChild("DtOfSgntr", Format(rstTrans!MandateDate, "YYYY-MM-DD")) ' default to jan 2013 if ported from DD
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", rstHeader!SEPA_UserID)
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", "")
Set CustomerBIC = CustomerFinInstnId.NewChild("BIC", rstTrans!BIC) 'rstHeader!SEPA_BIC)
Set Customer = DDTransactionInformation.NewChild("Dbtr", "")
Set CustomerName = Customer.NewChild("Nm", FindAndReplace(rstTrans!DebtorsName, "&", "+"))
Set CustomerAccount = DDTransactionInformation.NewChild("DbtrAcct", "")
Set CustomerAccId = CustomerAccount.NewChild("Id", "")
Set CustomerIBAN = CustomerAccId.NewChild("IBAN", rstTrans!IBAN)
'end loop on payment
rstTrans.MoveNext
Loop
success = xml.SaveXml(rstHeader!ExportFileName)
If (success <> 1) Then
MsgBox xml.LastErrorText
Else
MsgBox "File Created " & rstHeader!ExportFileName
End If
Set rstTrans = Nothing
Set rstHeader = Nothing
Exit Function
Errorhandler:
MsgBox "An Error Occurred creating the File " & Err.Number & " " & Err.Description
End Function