'<?xml version="1.0" encoding="UTF-8" standalone="true"?>
Criterio = "<?xml version="
Criterio = Criterio & """1.0"""
Criterio = Criterio & " encoding="
Criterio = Criterio & """UTF-8"""
Criterio = Criterio & " standalone="
Criterio = Criterio & """yes"
Criterio = Criterio & """?>"
Print #1, Criterio
' create/load your xml document
'Criterio = "'<?xml version="1.0"'"
'Criterio = Criterio & " encoding="UTF-8""
'Criterio = Criterio & " standalone="true"?>"
'Print #1, Criterio
Criterio = "<Document xmlns="
Criterio = Criterio & """urn:iso:std:iso:20022:tech:xsd:pain.008.001.02"
Criterio = Criterio & """ xmlns:xsi="""
Criterio = Criterio & "http://www.w3.org/2001/XMLSchema-instance"""
Criterio = Criterio & ">"
Print #1, Criterio
Print #1, "<CstmrDrctDbtInitn>"
Print #1, "<GrpHdr>"
Campo5FechaCliente = Date
Criterio = "<MsgId>"
Criterio = Criterio & "PRE"
Criterio = Criterio & Mid(Campo5FechaCliente, 7, 4) & Mid(Campo5FechaCliente, 4, 2) & Mid(Campo5FechaCliente, 1, 2)
Criterio = Criterio & Format(Time(), "hhmmss")
Criterio = Criterio & "00818bsWindowsAE11"
Criterio = Criterio & "</MsgId>"
Print #1, Criterio
'------ Fecha y hora de la remesa -------
Criterio = "<CreDtTm>"
Criterio = Criterio & Mid(Campo5FechaCliente, 7, 4) & "-" & Mid(Campo5FechaCliente, 4, 2) & "-" & Mid(Campo5FechaCliente, 1, 2)
Criterio = Criterio & "T"
Criterio = Criterio & Time()
Criterio = Criterio & "</CreDtTm>"
Print #1, Criterio
'------ Contar numero de recibos -------
Criterio = "<NbOfTxs>"
Criterio = Criterio & Contador
Criterio = Criterio & "</NbOfTxs>"
Print #1, Criterio
'------ Suma Total de recibos -------
Entero = Int(Total)
Decimas = (Total - Entero) * 100
Criterio = "<CtrlSum>"
Criterio = Criterio & Entero
Criterio = Criterio & "."
Criterio = Criterio & Format(Decimas, "00")
Criterio = Criterio & "</CtrlSum>"
Print #1, Criterio
Print #1, "<InitgPty>"
Criterio = "<Nm>"
Criterio = Criterio & NombreEmpresa
Criterio = Criterio & "</Nm>"
Print #1, Criterio
Print #1, "<Id>"
Print #1, "<PrvtId>"
Print #1, "<Othr>"
Criterio = "<Id>"
Criterio = Criterio & "ES19"
Criterio = Criterio & Sufijo
Criterio = Criterio & Mid(CifEmpresa, 1, 9)
Criterio = Criterio & "</Id>"
Print #1, Criterio
Print #1, "</Othr>"
Print #1, "</PrvtId>"
Print #1, "</Id>"
Print #1, "</InitgPty>"
Print #1, "</GrpHdr>"
'--------- Bucle Vencimiento por Cliente --------------------
ContadorRecibos = Contador
CursorEfectos.MoveFirst
'CursorEfectos.EOF
'--------------------------------- BUCLE INICIO CABECERA VENCIMIENTO Y DESPUES EL RECIBO --------------------
Do Until CursorEfectos.EOF
'ContadorRecibos = 0
'------------------------- VARIABLES --------------------------------------
If IbanCliente = " " Then MsgBox ("Falta codigo IBAN en el cliente , No se puede continuar (" & CodigoCliente & ")(" & NombreCliente & ")"), vbInformation
'msgbox("usted debe (" & tuvariable & ")" )
If BicSwiftCliente = " " Then MsgBox ("Falta codigo BICSwift en el cliente , No se puede continuar (" & CodigoCliente & ")(" & NombreCliente & ")"), vbInformation
If IbanEmpresa = " " Then MsgBox ("Falta codigo IBAN en la ficha de empresa , No se puede continuar (" & NombreEmpresa & ")"), vbInformation
If BicSwiftEmpresa = " " Then MsgBox ("Falta codigo BICSwift en la ficha de empresa , No se puede continuar (" & NombreEmpresa & ")"), vbInformation
NombreCliente = CursorEfectos!Nombre
CodigoCliente = CursorEfectos!numcli
BicSwiftCliente = CursorEfectos!BicSwift
IbanCliente = CursorEfectos!IBAN
BancoCliente = CursorEfectos!Banco
AgenciaCliente = CursorEfectos!Sucursal
NumeroFactura = CursorEfectos!NumeroFactura
DigitoControl = CursorEfectos!DigitoControl
NumeroCuenta = CursorEfectos!NCuenta
Direccion = CursorEfectos!Direccion
Poblacion = CursorEfectos!Poblacion
CodigoPostal = CursorEfectos!CodigoPostal
Campo4Vencimiento = Format(CursorEfectos!Vencimiento, "dd/mm/yyyy")
EnteroCliente = Int(CursorEfectos!ImporteEfecto)
DecimasCliente = (CursorEfectos!ImporteEfecto - EnteroCliente) * 100
Campo5FechaCliente = Format(CursorEfectos!FechaRemesa, "dd/mm/yyyy")
'------------------------- FIN VARIABLES ----------------------------------
'------------------------- REEMPLAZAR CARACTERES NO COMPATIBLES -----------
'-------- NombreCliente ---- Ñ --- x --- N -------
Dim v As String
v = Replace(NombreCliente, "Ñ", "N")
NombreCliente = v
v = Replace(NombreCliente, "&", " ")
NombreCliente = v
'-------- Direccion Cliente --se pondra un espacio ---- " " -------
Dim D As String
D = Replace(Direccion, "|", " ")
Direccion = D
D = Replace(Direccion, "º", " ")
Direccion = D
D = Replace(Direccion, "&", " ")
Direccion = D
D = Replace(Direccion, "<", " ")
Direccion = D
D = Replace(Direccion, ">", " ")
Direccion = D
D = Replace(Direccion, "'", " ")
Direccion = D
D = Replace(Direccion, "Ñ", "N")
Direccion = D
Print #1, "<PmtInf>"
Criterio = "<PmtInfId>"
Criterio = Criterio & Mid(Campo5FechaCliente, 7, 4) & Mid(Campo5FechaCliente, 4, 2) & Mid(Campo5FechaCliente, 1, 2)
Criterio = Criterio & Format(Time(), "hhmmss")
Criterio = Criterio & " SepaRemesa"
Criterio = Criterio & "</PmtInfId>"
Print #1, Criterio
Criterio = "<PmtMtd>"
Criterio = Criterio & "DD"
Criterio = Criterio & "</PmtMtd>"
Print #1, Criterio
Criterio = "<BtchBookg>"
Criterio = Criterio & "false"
Criterio = Criterio & "</BtchBookg>"
Print #1, Criterio
Print #1, "<PmtTpInf>"
Print #1, "<SvcLvl>"
Criterio = "<Cd>"
Criterio = Criterio & "SEPA"
Criterio = Criterio & "</Cd>"
Print #1, Criterio
Print #1, "</SvcLvl>"
Print #1, "<LclInstrm>"
Criterio = "<Cd>"
Criterio = Criterio & "CORE"
Criterio = Criterio & "</Cd>"
Print #1, Criterio
Print #1, "</LclInstrm>"
Criterio = "<SeqTp>"
Criterio = Criterio & "RCUR"
Criterio = Criterio & "</SeqTp>"
Print #1, Criterio
Print #1, "</PmtTpInf>"
Criterio = "<ReqdColltnDt>"
'Campo4Vencimiento = CursorEfectos!Vencimiento
Criterio = Criterio & Mid(Campo4Vencimiento, 7, 4) & "-" & Mid(Campo4Vencimiento, 4, 2) & "-" & Mid(Campo4Vencimiento, 1, 2)
Criterio = Criterio & "</ReqdColltnDt>"
Print #1, Criterio
'<ReqdColltnDt>2016-01-25</ReqdColltnDt>
Print #1, "<Cdtr>"
Criterio = "<Nm>"
Criterio = Criterio & NombreEmpresa
Criterio = Criterio & "</Nm>"
Print #1, Criterio
Print #1, "<PstlAdr>"
Criterio = "<Ctry>"
Criterio = Criterio & "ES"
Criterio = Criterio & "</Ctry>"
Print #1, Criterio
Criterio = "<AdrLine>"
Criterio = Criterio & DireccionEmpresa
Criterio = Criterio & " "
Criterio = Criterio & LocalidadEmpresa
Criterio = Criterio & " "
Criterio = Criterio & ProvinciaEmpresa
Criterio = Criterio & "</AdrLine>"
Print #1, Criterio
Print #1, "</PstlAdr>"
Print #1, "</Cdtr>"
Print #1, "<CdtrAcct>"
Print #1, "<Id>"
Criterio = "<IBAN>"
Criterio = Criterio & IbanEmpresa
Criterio = Criterio & CuentaEmpresa
Criterio = Criterio & "</IBAN>"
Print #1, Criterio
Print #1, "</Id>"
Print #1, "</CdtrAcct>"
Print #1, "<CdtrAgt>"
Print #1, "<FinInstnId>"
Criterio = "<BIC>"
Criterio = Criterio & BicSwiftEmpresa
Criterio = Criterio & "</BIC>"
Print #1, Criterio
Print #1, "</FinInstnId>"
Print #1, "</CdtrAgt>"
Print #1, "<CdtrSchmeId>"
Print #1, "<Id>"
Print #1, "<PrvtId>"
Print #1, "<Othr>"
Criterio = "<Id>"
Criterio = Criterio & idacreedor
Criterio = Criterio & Sufijo
Criterio = Criterio & Mid(CifEmpresa, 1, 9)
Criterio = Criterio & "</Id>"
Print #1, Criterio
Print #1, "<SchmeNm>"
Criterio = "<Prtry>"
Criterio = Criterio & "SEPA"
Criterio = Criterio & "</Prtry>"
Print #1, Criterio
Print #1, "</SchmeNm>"
Print #1, "</Othr>"
Print #1, "</PrvtId>"
Print #1, "</Id>"
Print #1, "</CdtrSchmeId>"
'---------------------------------------------- DATOS DE LOS CLIENTES ----------------------------------------
Print #1, "<DrctDbtTxInf>"
Print #1, "<PmtId>"
Criterio = "<EndToEndId>"
Criterio = Criterio & "000000"
Criterio = Criterio & " "
Criterio = Criterio & "0000000000"
Criterio = Criterio & " "
Criterio = Criterio & Mid(Campo5FechaCliente, 7, 4) & Mid(Campo5FechaCliente, 4, 2) & Mid(Campo5FechaCliente, 1, 2)
Criterio = Criterio & "195412000"
Criterio = Criterio & "</EndToEndId>"
Print #1, Criterio
'<EndToEndId>000000 0000000000 20151127195412000</EndToEndId>
Print #1, "</PmtId>"
'------ Suma recibo o recibos ----------------
Criterio = "<InstdAmt Ccy="
Criterio = Criterio & """EUR"""
Criterio = Criterio & ">"
Criterio = Criterio & EnteroCliente
Criterio = Criterio & "."
Criterio = Criterio & Format(DecimasCliente, "00")
Criterio = Criterio & "</InstdAmt>"
Print #1, Criterio
'<InstdAmt Ccy="EUR">125.09</InstdAmt>
Print #1, "<DrctDbtTx>"
Print #1, "<MndtRltdInf>"
Criterio = "<MndtId>"
Criterio = Criterio & Format(CodigoCliente, "000000000000")
Criterio = Criterio & "</MndtId>"
Print #1, Criterio
'<MndtId>000000030417</MndtId>
Criterio = "<DtOfSgntr>"
Criterio = Criterio & "2009-10-31"
Criterio = Criterio & "</DtOfSgntr>"
Print #1, Criterio
Print #1, "</MndtRltdInf>"
Print #1, "</DrctDbtTx>"
Print #1, "<DbtrAgt>"
Print #1, "<FinInstnId>"
Criterio = "<BIC>"
Criterio = Criterio & BicSwiftCliente
Criterio = Criterio & "</BIC>"
Print #1, Criterio
Print #1, "</FinInstnId>"
Print #1, "</DbtrAgt>"
Print #1, "<Dbtr>"
Criterio = "<Nm>"
Criterio = Criterio & NombreCliente
Criterio = Criterio & "</Nm>"
Print #1, Criterio
Print #1, "<PstlAdr>"
Criterio = "<Ctry>"
Criterio = Criterio & "ES"
Criterio = Criterio & "</Ctry>"
Print #1, Criterio
Criterio = "<AdrLine>"
Criterio = Criterio & Direccion
Criterio = Criterio & CodigoPostal
Criterio = Criterio & " "
Criterio = Criterio & Poblacion
Criterio = Criterio & "</AdrLine>"
Print #1, Criterio
'<AdrLine>C/ JON PEREZ, 11-2 PLANTA 28010 Barcelona. Barcelona</AdrLine>
Print #1, "</PstlAdr>"
Print #1, "</Dbtr>"
Print #1, "<DbtrAcct>"
Print #1, "<Id>"
Criterio = "<IBAN>"
Criterio = Criterio & IbanCliente
Criterio = Criterio & BancoCliente
Criterio = Criterio & AgenciaCliente
Criterio = Criterio & DigitoControl
Criterio = Criterio & NumeroCuenta
Criterio = Criterio & "</IBAN>"
Print #1, Criterio
'<IBAN>ES2911112222334444444444</IBAN>
Print #1, "</Id>"
Print #1, "</DbtrAcct>"
Print #1, "<RmtInf>"
'-------------------------------- Concepto del cargo al cliente -----------------------
Criterio = "<Ustrd>"
Criterio = Criterio & NombreEmpresa
Criterio = Criterio & " Factura:"
Criterio = Criterio & NumeroFactura
'Criterio = Criterio & "........................................"
Criterio = Criterio & "</Ustrd>"
Print #1, Criterio
Print #1, "</RmtInf>"
Print #1, "</DrctDbtTxInf>"
Print #1, "</PmtInf>"
CursorEfectos.MoveNext
Loop
Print #1, "</CstmrDrctDbtInitn>"
Print #1, "</Document>"
Close #1
MsgBox "Fichero:" & Fichero & " Grabado Correctamente"