Visual Basic - Sepa XML en visual basic

<?xml version="1.0" encoding="utf-8"?>

<Document xmlns="urn:iso:std:iso:20022:tech:xsd:pain.008.001.02" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance";>

<CstmrDrctDbtInitn>

<GrpHdr>

<MsgId>PRE2013102809583113000ES80B11111111</MsgId>

<CreDtTm>2013-10-28T09:58:31</CreDtTm>

<NbOfTxs>2</NbOfTxs>

<CtrlSum>2517.33</CtrlSum>

<InitgPty>

<Nm>EMPRESA PRUEBAS,S.L.U.</Nm>

     <Id>

         <OrgId>

             <Othr>

                 <Id>ES46J03118115</Id>

             </Othr>

         </OrgId>

     </Id>

</InitgPty>

</GrpHdr>

<PmtInf>

     <PmtInfId>2013-10-28_095831Remesa 218</PmtInfId>

     <PmtMtd>DD</PmtMtd>

     <PmtTpInf>

         <SvcLvl>

             <Cd>SEPA</Cd>

         </SvcLvl>

         <LclInstrm>

             <Cd>CORE</Cd>

         </LclInstrm>

         <SeqTp>RCUR</SeqTp>

         <CtgyPurp>

             <Cd>TRAD</Cd>

         </CtgyPurp>

     </PmtTpInf>

     <ReqdColltnDt>2013-09-30</ReqdColltnDt>

     <Cdtr>

             <Nm>EMPRESA PRUEBAS,S.L.U.</Nm>

             <Id>

                 <PrvtId>

                     <Othr>

                         <Id>ES46J03118115</Id>

                     </Othr>

                 </PrvtId>

             </Id>

     </Cdtr>

     <CdtrAcct>

             <Id>

                 <IBAN>ES8011111111111111111</IBAN>

             </Id>

             <Ccy>EUR</Ccy>

     </CdtrAcct>

     <CdtrAgt>

             <FinInstnId>

                 <BIC>BKBKESMM</BIC>

             </FinInstnId>

     </CdtrAgt>

     <ChrgBr>SLEV</ChrgBr>

<DrctDbtTxInf>

     <PmtId>

          <InstrId> 20130930Fra.509301</InstrId>

          <EndToEndId> 20130930Fra.509301</EndToEndId>

     </PmtId>

     <InstdAmt Ccy="EUR">2499.99</InstdAmt>

     <DrctDbtTx>

         <MndtRltdInf>

             <MndtId>4330027115</MndtId>

             <DtOfSgntr>2009-10-31</DtOfSgntr>

             <AmdmntInd>false</AmdmntInd>

         </MndtRltdInf>

         <CdtrSchmeId>

         <Id>

             <PrvtId>

                 <Othr>

                     <Id>ES46J03118115</Id>

                     <SchmeNm>

                         <Prtry>SEPA</Prtry>

                     </SchmeNm>

                 </Othr>

             </PrvtId>

         </Id>

         </CdtrSchmeId>

     </DrctDbtTx>

     <DbtrAgt>

         <FinInstnId>

             <BIC>BSABESBB</BIC>

         </FinInstnId>

     </DbtrAgt>

     <Dbtr>

         <Nm>CLIENTE 1, S.A.</Nm>

         <Id>

             <OrgId>

                 <BICOrBEI>BSABESBB</BICOrBEI>

             </OrgId>

         </Id>

     </Dbtr>

     <DbtrAcct>

         <Id>

             <IBAN>ES66111111118103221103</IBAN>

         </Id>

         <Ccy>EUR</Ccy>

     </DbtrAcct>

     <RmtInf>

         <Ustrd>Fra. 13 01            5.093</Ustrd>

     </RmtInf>

</DrctDbtTxInf>

<DrctDbtTxInf>

     <PmtId>

          <InstrId> 20130930Fra.508901</InstrId>

          <EndToEndId> 20130930Fra.508901</EndToEndId>

     </PmtId>

     <InstdAmt Ccy="EUR">17.34</InstdAmt>

     <DrctDbtTx>

         <MndtRltdInf>

             <MndtId>4350025048</MndtId>

             <DtOfSgntr>2009-10-31</DtOfSgntr>

             <AmdmntInd>false</AmdmntInd>

         </MndtRltdInf>

         <CdtrSchmeId>

         <Id>

             <PrvtId>

                 <Othr>

                     <Id>ES46J03118115</Id>

                     <SchmeNm>

                         <Prtry>SEPA</Prtry>

                     </SchmeNm>

                 </Othr>

             </PrvtId>

         </Id>

         </CdtrSchmeId>

     </DrctDbtTx>

     <DbtrAgt>

         <FinInstnId>

             <BIC>BSABESBB</BIC>

         </FinInstnId>

     </DbtrAgt>

     <Dbtr>

         <Nm>CLIENTE 2, S.L.</Nm>

         <Id>

             <OrgId>

                 <BICOrBEI>BSABESBB</BICOrBEI>

             </OrgId>

         </Id>

     </Dbtr>

     <DbtrAcct>

         <Id>

             <IBAN>ES55008103221100010XXXX</IBAN>

         </Id>

         <Ccy>EUR</Ccy>

     </DbtrAcct>

     <RmtInf>

         <Ustrd>Fra. 13 01            5.089</Ustrd>

     </RmtInf>

</DrctDbtTxInf>

</PmtInf>

</CstmrDrctDbtInitn>

</Document>

'<?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"

Dim doc As MSXML2.DOMDocument

        Set doc = New DOMDocument

       'CABECERA Y ESQUEMA XML***************************

        Dim codificacion As Variant

        Set codificacion = doc.createProcessingInstruction("xml", "version='1.0' encoding='utf-8'")

        doc.appendChild codificacion

        Dim esquema As IXMLDOMElement

        Set esquema = doc.createElement("Document")

        esquema.setAttribute "xmlns", "urn:iso:std:iso:20022:tech:xsd:pain.008.001.02"

        esquema.setAttribute "xmlns:xsi", "http://www.w3.org/2001/XMLSchema-instance"

        doc.appendChild esquema