Dim qdef As QueryDef
Dim rst As dao.Recordset
Dim qupdef As QueryDef
Dim doc As Separatista.SeparatistaDocument
Dim frstpmtinf As Separatista.Element
Dim rcurpmtinf As Separatista.Element
Dim txinf As Separatista.Element
Dim cstmrdrctdbtinitn As Separatista.Element
Dim vdate As String
Dim periode As String
vdate = InputBox("Please enter the execution date", "Enter date", Date)
If vdate = "" Then Exit Sub
' Get data from Database
Set qdef = CurrentDb.QueryDefs("Betaal_ExportIncasso")
qdef.Parameters("periodeid") = Me!PeriodeCombo
Set rst = qdef.OpenRecordset
' Personal information
reknaam = DLookup("rekeningnaam", "Gebruiker")
reknummer = DLookup("incassorekeningnummer", "Gebruiker")
reknummerbic = DLookup("incassobic", "Gebruiker")
incassocode = DLookup("incassocode", "Gebruiker")
periode = DLookup("naam", "BetaalPerioden", "id=" & Str(Me!PeriodeCombo))
Set doc = New Separatista.SeparatistaDocument
doc.EnableAutoMagic = True
doc.Namespace = PAIN_008_001_02
Set cstmrdrctdbtinitn = doc.RootElement.CreateElementByTagName("CstmrDrctDbtInitn")
With cstmrdrctdbtinitn.CreateElementByTagName("GrpHdr")
.CreateElementByTagName("MsgId") = periode
.CreateElementByTagName("InitgPty").CreateElementByTagName("Nm") = reknaam
.CreateElementByTagName("CreDtTm").DataTimeValue = Now
End With
' Create PaymentInformation for first sequencetype
Set frstpmtinf = cstmrdrctdbtinitn.CreateElementByTagName("PmtInf", 0)
With frstpmtinf
.CreateElementByTagName("PmtInfId") = periode & "frst"
.CreateElementByTagName("PmtMtd") = "DD"
With .CreateElementByTagName("PmtTpInf")
.CreateElementByTagName("SvcLvl").CreateElementByTagName("Cd") = "SEPA"
.CreateElementByTagName("LclInstrm").CreateElementByTagName("Cd") = "CORE"
.CreateElementByTagName("SeqTp") = "FRST"
End With
.CreateElementByTagName("ReqdColltnDt").DateValue = vdate
.CreateElementByTagName("Cdtr").CreateElementByTagName("Nm") = reknaam
.CreateElementByTagName("CdtrAcct").CreateElementByTagName("Id").CreateElementByTagName("IBAN") = reknummer
.CreateElementByTagName("CdtrAgt").CreateElementByTagName("FinInstnId").CreateElementByTagName("BIC") = reknummerbic
.CreateElementByTagName("ChrgBr") = "SLEV"
With .CreateElementByTagName("CdtrSchmeId").CreateElementByTagName("Id").CreateElementByTagName("PrvtId").CreateElementByTagName("Othr")
.CreateElementByTagName("Id") = incassocode
.CreateElementByTagName("SchmeNm").CreateElementByTagName("Prtry") = "SEPA"
End With
End With
' Create PaymentInformation for recurring sequencetype
Set rcurpmtinf = cstmrdrctdbtinitn.CreateElementByTagName("PmtInf", 1)
With rcurpmtinf
.CreateElementByTagName("PmtInfId") = periode & "rcur"
.CreateElementByTagName("PmtMtd") = "DD"
With .CreateElementByTagName("PmtTpInf")
.CreateElementByTagName("SvcLvl").CreateElementByTagName("Cd") = "SEPA"
.CreateElementByTagName("LclInstrm").CreateElementByTagName("Cd") = "CORE"
.CreateElementByTagName("SeqTp") = "RCUR"
End With
.CreateElementByTagName("ReqdColltnDt").DateValue = vdate
.CreateElementByTagName("Cdtr").CreateElementByTagName("Nm") = reknaam
.CreateElementByTagName("CdtrAcct").CreateElementByTagName("Id").CreateElementByTagName("IBAN") = reknummer
.CreateElementByTagName("CdtrAgt").CreateElementByTagName("FinInstnId").CreateElementByTagName("BIC") = reknummerbic
.CreateElementByTagName("ChrgBr") = "SLEV"
With .CreateElementByTagName("CdtrSchmeId").CreateElementByTagName("Id").CreateElementByTagName("PrvtId").CreateElementByTagName("Othr")
.CreateElementByTagName("Id") = incassocode
.CreateElementByTagName("SchmeNm").CreateElementByTagName("Prtry") = "SEPA"
End With
End With
' Create and add all DirectDebitTransactionInformations
If Not rst.BOF Then rst.MoveFirst
Do Until rst.EOF
If IsNull(rst![iban]) Or IsNull(rst![bic]) Then
msg = "DirectDebit " & Str(rst![volgnummer]) & " from " & rst![achternaam] & " has no bank account information and will be ingored"
MsgBox msg, vbCritical + vbOKOnly, "No IBAN"
Else
' Add to the right PaymentInformation
If rst![teller] = 0 Then
Set txinf = frstpmtinf.CreateElementByTagName("DrctDbtTxInf", rst![volgnummer])
Else
Set txinf = rcurpmtinf.CreateElementByTagName("DrctDbtTxInf", rst![volgnummer])
End If
With txinf
.CreateElementByTagName("PmtId").CreateElementByTagName("EndToEndId") = periode
With .CreateElementByTagName("InstdAmt")
.CurrencyValue = rst![bedrag]
.SetAttributeValue "Ccy", "EUR"
End With
With .CreateElementByTagName("DrctDbtTx").CreateElementByTagName("MndtRltdInf")
.CreateElementByTagName("MndtId") = rst![abonnee]
.CreateElementByTagName("DtOfSgntr").DateValue = Nz(rst![ondertekeningsdatum], #7/1/2014#)
End With
.CreateElementByTagName("DbtrAgt").CreateElementByTagName("FinInstnId").CreateElementByTagName("BIC") = rst![bic]
.CreateElementByTagName("Dbtr").CreateElementByTagName("Nm") = Nz(rst![naam], rst![achternaam])
.CreateElementByTagName("DbtrAcct").CreateElementByTagName("Id").CreateElementByTagName("IBAN") = rst![iban]
With .CreateElementByTagName("RmtInf")
.CreateElementByTagName("Ustrd", 0) = Left(rst![omschrijving1], 140)
.CreateElementByTagName("Ustrd", 1) = Left(rst![omschrijving2], 140)
End With
End With
End If
rst.MoveNext
Loop
' Remove empty PaymentInformations
If frstpmtinf.GetElementByTagName("NbOfTxs") Is Nothing Or frstpmtinf.GetElementByTagName("NbOfTxs").Value = 0 Then cstmrdrctdbtinitn.DestroyElement frstpmtinf
If rcurpmtinf.GetElementByTagName("NbOfTxs") Is Nothing Or rcurpmtinf.GetElementByTagName("NbOfTxs").Value = 0 Then cstmrdrctdbtinitn.DestroyElement rcurpmtinf
doc.Save Me.Hwnd