Function CerosIzda(cadena, Longitud)
 Dim NumCeros, n, CadenaCeros
 If Len(cadena) < Longitud Then
    NumCeros = Longitud - Len(cadena)
    For n = 1 To NumCeros
        CadenaCeros = CadenaCeros & "0"
    Next
    CerosIzda = CadenaCeros & cadena
 Else
    CerosIzda = cadena
 End If
End Function

Function CaracteresSEPA(cadena)
       Dim X As Integer
       cadena = Replace(cadena, "", "N")
       cadena = Replace(cadena, "", "n")
       cadena = Replace(cadena, "", "C")
       cadena = Replace(cadena, "", "c")
       CaracteresSEPA = ""
       For X = 1 To Len(cadena)
          Select Case UCase(Mid(cadena, X, 1))
             Case "A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z"
                CaracteresSEPA = CaracteresSEPA & Mid(cadena, X, 1)
             Case "0", "1", "2", "3", "4", "5", "6", "7", "8", "9", "/", "-", "?", ":", "(", ")", ".", ",", "‘", "+", " "
                CaracteresSEPA = CaracteresSEPA & Mid(cadena, X, 1)
             Case Else
                CaracteresSEPA = CaracteresSEPA & "0"
          End Select
      Next
End Function


Public Sub pGenN19(EMId As Long, cFilename As String, Optional ByVal cCombinedRecs As String)
    
    'cCombinedRecs = RecId1,RecId2,RecId3...
    
    ' Cosas que hacen falta
    ' - Cod. Ordenante = CIF empresa ordenante (9)
    ' - Tipo/nombre ordenante =  (40)
    ' - Sufijo = 001 (3)
    ' - Moneda (pts,euro) => (0,5) (1)
    ' - Fecha de presentacion (ddmmyy)
    ' - Fecha de adeudo (ddmmyy)
    ' - bic(ESXX)
    ' - CodBanco
    ' - CodSucursal
    ' - DigControl
    ' - NumCuenta
    ' - Fecha emision
    ' - Cod Emision
    ' - Clave (concepto)
    ' (Recibos)
    
    Dim cCodOrdenante As String
    Dim cOrdenante As String
    Dim cSufijo As String
    Dim cMoneda As String
    Dim cFechaPresentacion As String
    Dim cFechaAdeudo As String
    Dim cBic As String
    Dim cCodBanco As String
    Dim cCodSucursal As String
    Dim cDigitoControl As String
    Dim cNumCuenta As String
    Dim cFechaEmision As String
    Dim cExplicacion As String
    Dim cNIFDeudor As String
    Dim cNombreDeudor As String
    Dim cAdrDeudor As String
    Dim vCachos(0 To 15) As String
    Dim nImporte As Currency
    Dim nImporteTotal As Currency
    Dim nOpci As Long
    Dim nRecibos As Long
    Dim nLineasN19 As Long
    Dim cTmp As String
    
    Dim cSQL As String
    Dim sb As StringBuffer
    Dim rs As ADODB.Recordset
    Dim rs2 As ADODB.Recordset
    Dim h As Long
    Dim i As Long
    Dim nWaitIndex As Long
    Dim nTime As Single
    Dim nFileAction         As Integer
    ' 0: do nothing
    ' 1: file copy
    ' 2: file pack (and copy)
    Dim sigue As Boolean
    Set sb = New StringBuffer
    
    cSQL = "SELECT STDGeneral.GNombreEntidad, STDGeneral.GCIFEntidad FROM STDGeneral"
    Set rs = CreateRS(gCnn, cSQL, adUseClient, adOpenForwardOnly, adLockOptimistic)
    If rs.EOF Then
        MsgBox "No existe informacin sobre el ordenante.", vbInformation + vbOKOnly, "Aviso:"
        pAssistForm frmDatosEntidad
        GoTo ya:
    Else
        If Trim("" & rs("gCIFEntidad")) = "" Or Trim("" & rs("gNombreEntidad")) = "" Then
            MsgBox "La informacin del ordenante est incompleta.", vbInformation + vbOKOnly, "Aviso:"
            pAssistForm frmDatosEntidad
            GoTo ya:
        End If
    End If
    
    cCodOrdenante = Trim("" & rs("gCIFEntidad"))
    If Len(cCodOrdenante) > 9 Then
        cCodOrdenante = Right(cCodOrdenante, 9)
    Else
        cCodOrdenante = String(9 - Len(cCodOrdenante), "0") & cCodOrdenante
    End If
    
    cOrdenante = Trim("" & rs("gNombreEntidad"))
    If Len(cOrdenante) > 40 Then
        cOrdenante = Right(cOrdenante, 40)
    Else
        cOrdenante = cOrdenante & Space(40 - Len(cOrdenante))
    End If
    
    
    
    DestroyRS rs
    
    cSQL = "SELECT * FROM STDEmisiones WHERE EMId=" & EMId
    Set rs = CreateRS(gCnn, cSQL, adUseClient, adOpenForwardOnly, adLockOptimistic)
    If rs.EOF Then
        MsgBox "No existe informacin sobre la emisin", vbInformation + vbOKOnly, "Aviso:"
        GoTo ya:
    End If
    
    cMoneda = IIf(rs("EMMoneda") = 0, "0", "5")
    
    cFechaEmision = Format(rs("EMFechaEmision"), "ddmmyy")
    cFechaAdeudo = Format(rs("EMFechaCargo"), "yyyy-mm-dd")
    cFechaPresentacion = Format(Now, "ddmmyy")
    
    cSQL = "SELECT * FROM STDCuentasPropias WHERE CPId=" & rs("EMCuentaPropia")
    DestroyRS rs
    Set rs2 = CreateRS(gCnn, cSQL, adUseClient, adOpenForwardOnly, adLockOptimistic)
    If rs2.EOF Then
        MsgBox "No existe informacin sobre la cuenta con que se hizo la emisin", vbInformation + vbOKOnly, "Aviso:"
        GoTo ya:
    End If
    
    With rs2
        cSufijo = !cpsufijo
        cBic = !cpbic
        cCodBanco = !cpCodBanco
        cCodSucursal = !cpCodSucursal
        cDigitoControl = !cpDigitoControl
        cNumCuenta = !cpNumCuenta
    End With
    DestroyRS rs2
    
    ' comenzamos a escribir
    Dim miIban As String
    miIban = cBic & cCodBanco & cCodSucursal & cDigitoControl & cNumCuenta
    Dim milisegundos As String
    Dim contadorTotal As Integer
    Dim IdentificadorAcreedor As String
    Dim ImporteAcreedor As Long

    Dim ContadorRegIndividualTotal As Integer
    Dim ContadorRegIndividualTotalConCabeceras As Integer
    Dim Contador003 As Integer
    Dim contador As Integer
    IdentificadorAcreedor = ""
    contadorTotal = 0
    milisegundos = fBuscarDato(gCnn, "select datePart(ms,getdate())")
    
    

    With sb
    
        IdentificadorAcreedor = IdentificadorAcreedorPresentadorSpain(cSufijo, cCodOrdenante)
        
    
        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' standalone='no'")
        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
        
        
        'RAIZ******************************************
         Dim raiz As IXMLDOMElement
         Set raiz = doc.createElement("CstmrDrctDbtInitn")

         esquema.appendChild raiz
        
        'CABECERA**************************************
        Dim cabecera As IXMLDOMElement
        Set cabecera = doc.createElement("GrpHdr")
        raiz.appendChild cabecera
        'idmensaje - ser el cif - fecha - hora
        Dim idmensaje As IXMLDOMElement
        Set idmensaje = doc.createElement("MsgId")
        idmensaje.Text = cCodOrdenante & "-" & CerosIzda(Day(Now), 2) & CerosIzda(Month(Now), 2) & CerosIzda(Year(Now), 2) & "-" & CerosIzda(Hour(Now), 2) & ":" & CerosIzda(Minute(Now), 2)
        cabecera.appendChild idmensaje
        'fechahora
        Dim fechahora As IXMLDOMElement
        Set fechahora = doc.createElement("CreDtTm")
        fechahora.Text = CerosIzda(Year(Now), 2) & "-" & CerosIzda(Month(Now), 2) & "-" & CerosIzda(Day(Now), 2) & "T" & CerosIzda(Hour(Now), 2) & ":" & CerosIzda(Minute(Now), 2) & ":" & CerosIzda(Second(Now), 2)
        cabecera.appendChild fechahora
        'nmero de operaciones
        Dim numOps As IXMLDOMElement
        Set numOps = doc.createElement("NbOfTxs")

        numOps.Text = "111"
        cabecera.appendChild numOps
        
        'importe total de operaciones
        Dim suma As IXMLDOMElement
        Set suma = doc.createElement("CtrlSum")
        suma.Text = "10.00"
        cabecera.appendChild suma
        
        'presentador
        Dim presentador As IXMLDOMElement
        Set presentador = doc.createElement("InitgPty")
        cabecera.appendChild presentador
        'nombre presentador
        Dim nbpresentador As IXMLDOMElement
        Set nbpresentador = doc.createElement("Nm")
        nbpresentador.Text = CaracteresSEPA(cOrdenante)
        presentador.appendChild nbpresentador
        'id
        Dim idpresentador As IXMLDOMElement
        Set idpresentador = doc.createElement("Id")
        presentador.appendChild idpresentador
        'persona jurdica
        Dim personajuridica As IXMLDOMElement
        Set personajuridica = doc.createElement("OrgId")
        idpresentador.appendChild personajuridica
        'otro
        Dim otro As IXMLDOMElement
        Set otro = doc.createElement("Othr")
        personajuridica.appendChild otro
        'idotro
        Dim idotro As IXMLDOMElement
        Set idotro = doc.createElement("Id")
        idotro.Text = IdentificadorAcreedor
        otro.appendChild idotro
        
        'idchmenm
        Dim idch As IXMLDOMElement
        Set idch = doc.createElement("SchmeNm")
        otro.appendChild idch
        
        'idtipocore
        Dim idtipocore As IXMLDOMElement
        Set idtipocore = doc.createElement("Cd")
        idtipocore.Text = "CORE"
        idch.appendChild idtipocore
        
        
        'INFORMACIN DE PAGO********************************
        Dim infpago As IXMLDOMElement
        Set infpago = doc.createElement("PmtInf")
        raiz.appendChild infpago
        'id de pago = cif - fecha - hora
        Dim idPago As IXMLDOMElement
        Set idPago = doc.createElement("PmtInfId")
        idPago.Text = cCodOrdenante & "-" & CerosIzda(Day(Now), 2) & CerosIzda(Month(Now), 2) & CerosIzda(Year(Now), 2) & "-" & CerosIzda(Hour(Now), 2) & ":" & CerosIzda(Minute(Now), 2)
        infpago.appendChild idPago
        'mtodo pago
        Dim metodopago As IXMLDOMElement
        Set metodopago = doc.createElement("PmtMtd")
        metodopago.Text = "DD"
        infpago.appendChild metodopago
        'n transacciones
        Dim numOps2 As IXMLDOMElement
        Set numOps2 = doc.createElement("NbOfTxs")
        numOps2.Text = "888"
        infpago.appendChild numOps2
        'importe total de operaciones
        Dim suma2 As IXMLDOMElement
        Set suma2 = doc.createElement("CtrlSum")
        suma2.Text = "4444"
        infpago.appendChild suma2
        'inf tipo pago
        Dim inftipopago As IXMLDOMElement
        Set inftipopago = doc.createElement("PmtTpInf")
        infpago.appendChild inftipopago
        'nivel servicio
        Dim nivelservicio As IXMLDOMElement
        Set nivelservicio = doc.createElement("SvcLvl")
        inftipopago.appendChild nivelservicio
        'code
        Dim code As IXMLDOMElement
        Set code = doc.createElement("Cd")
        code.Text = "SEPA"
        nivelservicio.appendChild code
        'instrumento local
        Dim instrumentolocal As IXMLDOMElement
        Set instrumentolocal = doc.createElement("LclInstrm")
        inftipopago.appendChild instrumentolocal
        Dim code2 As IXMLDOMElement
        Set code2 = doc.createElement("Cd")
        code2.Text = "CORE"
        instrumentolocal.appendChild code2
        'tipo se secuencia
        Dim tiposecuencia As IXMLDOMElement
        Set tiposecuencia = doc.createElement("SeqTp")
        tiposecuencia.Text = "RCUR"
        inftipopago.appendChild tiposecuencia
        'fecha de cobro
        Dim fecha_cobro As IXMLDOMElement
        Set fecha_cobro = doc.createElement("ReqdColltnDt")
        fecha_cobro.Text = cFechaAdeudo
        infpago.appendChild fecha_cobro
        'acreedor
        Dim acreedor As IXMLDOMElement
        Set acreedor = doc.createElement("Cdtr")
        infpago.appendChild acreedor
        'nombre acreedor
        Dim nbacreedor As IXMLDOMElement
        Set nbacreedor = doc.createElement("Nm")
        nbacreedor.Text = CaracteresSEPA(cOrdenante)
        acreedor.appendChild nbacreedor
        '**faltara poner direccin postal (pais y direccin)
        'ccc acreedor
        Dim cccacreedor As IXMLDOMElement
        Set cccacreedor = doc.createElement("CdtrAcct")
        infpago.appendChild cccacreedor
        'idcccacreedor
        Dim idcccacreedor As IXMLDOMElement
        Set idcccacreedor = doc.createElement("Id")
        cccacreedor.appendChild idcccacreedor
        'iban acreedor
        Dim ibanacreedor As IXMLDOMElement
        Set ibanacreedor = doc.createElement("IBAN")
        ibanacreedor.Text = miIban
        idcccacreedor.appendChild ibanacreedor
        '**faltaria swift de entidad, que no es necesario
        'slev
        Dim slev As IXMLDOMElement
        Set slev = doc.createElement("ChrgBr")
        slev.Text = "SLEV"
        infpago.appendChild slev
        
        'acreedor
        Dim miacree As IXMLDOMElement
        Set miacree = doc.createElement("CdtrSchmeId")
        infpago.appendChild miacree
        'idacreedor
        Dim idmiacree As IXMLDOMElement
        Set idmiacree = doc.createElement("Id")
        miacree.appendChild idmiacree
        'pvtacreedor
        Dim pvtacreedor As IXMLDOMElement
        Set pvtacreedor = doc.createElement("PrvtId")
        idmiacree.appendChild pvtacreedor
        'otraacreedor
        Dim otraacreedor As IXMLDOMElement
        Set otraacreedor = doc.createElement("Othr")
        pvtacreedor.appendChild otraacreedor
        
        Dim idotro2 As IXMLDOMElement
        Set idotro2 = doc.createElement("Id")
        idotro2.Text = IdentificadorAcreedor
        otraacreedor.appendChild idotro2
        
        Dim schema As IXMLDOMElement
        Set schema = doc.createElement("SchmeNm")
        otraacreedor.appendChild schema
        
        Dim prop As IXMLDOMElement
        Set prop = doc.createElement("Prtry")
        prop.Text = "SEPA"
        schema.appendChild prop
        
        
        
      
        contadorTotal = contadorTotal + 1
        
      

          
         
          Dim fechacobro As String
          fechacobro = cFechaAdeudo
          fechacobro = "20" & Right(fechacobro, 2) & Mid(fechacobro, 3, 2) & Left(fechacobro, 2)
         
          contadorTotal = contadorTotal + 1
                            
    
    
        
        cSQL = "SELECT * FROM STDRecibos WHERE RETotal>0 AND REFormaPago=0 AND REEmision=" & EMId & IIf(cCombinedRecs = "", "", " AND REId IN (" & cCombinedRecs & ")") & " ORDER BY REId"
        Set rs = CreateRS(gCnn, cSQL, adUseClient, adOpenForwardOnly, adLockOptimistic)
        nRecibos = 0
        If Not rs.EOF Then
            nRecibos = rs.RecordCount
        End If
        
        nWaitIndex = 0
        Dim ImporteBloqueAcreedor As Long
        Dim ContadorRegIndividual As Integer
        Dim importefinal As Long
        Dim infPagoDeudor As IXMLDOMElement
        Dim idPagoDeudor As IXMLDOMElement
        Dim iddeudorpago As IXMLDOMElement
        Dim cantidadpago As IXMLDOMElement
        
        'actualizar nmero de recibos (transacciones)
        Dim auxiliar As IXMLDOMElement
        
        Set auxiliar = doc.selectSingleNode("//NbOfTxs")
        auxiliar.Text = rs.RecordCount
        Set auxiliar = doc.selectSingleNode("//CstmrDrctDbtInitn/PmtInf/NbOfTxs")
        auxiliar.Text = rs.RecordCount
        nRecibos = rs.RecordCount
        
        
       'doc.getElementsByTagName("NbOfTxs");
        While Not rs.EOF
            cNIFDeudor = fCreaCif(rs("REUsuarioInteresado"), "" & rs("RECodBanco") & rs("RECodSucursal") & rs("REDigitoControl") & rs("RENumCuenta"))
            cNombreDeudor = "" & fBuscarDato(gCnn, "SELECT SONombre FROM STDSocios WHERE SOId=" & rs("REUsuarioInteresado"))
            cAdrDeudor = "" & fBuscarDato(gCnn, "SELECT sodireccion + ' ,' + sopoblacion  from  STDSocios WHERE SOId=" & rs("REUsuarioInteresado"))
            If Len(cNombreDeudor) > 40 Then
                cNombreDeudor = Left(cNombreDeudor, 40)
            Else
                cNombreDeudor = cNombreDeudor & String(40 - Len(cNombreDeudor), " ")
            End If
           cNombreDeudor = CaracteresSEPA(cNombreDeudor)
           cAdrDeudor = CaracteresSEPA(cAdrDeudor)
          
            nImporte = rs("RETotal")
            nImporteTotal = nImporteTotal + nImporte
            

            
          
            
        
        Set infPagoDeudor = doc.createElement("DrctDbtTxInf")
        infpago.appendChild infPagoDeudor
        Set idPagoDeudor = doc.createElement("PmtId")
        infPagoDeudor.appendChild idPagoDeudor
        'idextremoaextremo
        Set iddeudorpago = doc.createElement("EndToEndId")
        iddeudorpago.Text = Trim(CaracteresSEPA(Format(rs("REEmision"), "000000") & CaracteresSEPA(Format(rs("REId"), "0000000000"))))
        idPagoDeudor.appendChild iddeudorpago
        'cantidad pago
        Set cantidadpago = doc.createElement("InstdAmt")
        cantidadpago.setAttribute "Ccy", "EUR"
        cantidadpago.Text = De_Num_a_Tx_01(FormatNumber(CDec(nImporte), 2)) 'cantidad con punto y dos decimales
        infPagoDeudor.appendChild cantidadpago
        
        Dim slev2 As IXMLDOMElement
        Set slev2 = doc.createElement("ChrgBr")
        slev2.Text = "SLEV"
        infPagoDeudor.appendChild slev2
        
        Dim adeudodirecto As IXMLDOMElement
        Set adeudodirecto = doc.createElement("DrctDbtTx")
        infPagoDeudor.appendChild adeudodirecto
        'INFO MANDATO
        Dim infmandato As IXMLDOMElement
        Set infmandato = doc.createElement("MndtRltdInf")
        adeudodirecto.appendChild infmandato
        
        'id mandato
        Dim idmandato As IXMLDOMElement
        Set idmandato = doc.createElement("MndtId")
        idmandato.Text = Trim(CaracteresSEPA(Format(rs("REEmision"), "000000") & CaracteresSEPA(Format(rs("REId"), "0000000000"))))
        infmandato.appendChild idmandato
        'fecha de firma mandato
        Dim ffirmamandato As IXMLDOMElement
        Set ffirmamandato = doc.createElement("DtOfSgntr")
        ffirmamandato.Text = CerosIzda(Year(cFechaAdeudo), 2) & "-" & CerosIzda(Month(cFechaAdeudo), 2) & "-" & CerosIzda(Day(cFechaAdeudo), 2)
        infmandato.appendChild ffirmamandato
        'mandato modificado?
        Dim mandatomodificado As IXMLDOMElement
        Set mandatomodificado = doc.createElement("AmdmntInd")
        mandatomodificado.Text = "FALSE"
        infmandato.appendChild mandatomodificado
        'deudor
        Dim deudor As IXMLDOMElement
        Set deudor = doc.createElement("DbtrAgt")
        infPagoDeudor.appendChild deudor
        'bicdeudor
        Dim bicdeudor As IXMLDOMElement
        Set bicdeudor = doc.createElement("FinInstnId")
        bicdeudor.Text = "BIC"
        deudor.appendChild bicdeudor
        'bicdeudor

        'deudor
        Dim mideudor As IXMLDOMElement
        Set mideudor = doc.createElement("Dbtr")
        infPagoDeudor.appendChild mideudor
        
        'deudor nombre
        Dim mideudornb As IXMLDOMElement
        Set mideudornb = doc.createElement("Nm")
        mideudornb.Text = cNombreDeudor
        mideudor.appendChild mideudornb
        
        'dir postal
        Dim dirpostal As IXMLDOMElement
        Set dirpostal = doc.createElement("PstlAdr")
        mideudor.appendChild dirpostal
        'pais
        Dim paisdeudor As IXMLDOMElement
        Set paisdeudor = doc.createElement("Ctry")
        paisdeudor.Text = "ES"
        dirpostal.appendChild paisdeudor
        'dir postal en txt
        Dim dirpostaltxt As IXMLDOMElement
        Set dirpostaltxt = doc.createElement("AdrLine")
        dirpostaltxt.Text = cAdrDeudor
        dirpostal.appendChild dirpostaltxt
        'cccdeudor
        Dim cccdeudor As IXMLDOMElement
        Set cccdeudor = doc.createElement("DbtrAcct")
        mideudor.appendChild cccdeudor
        'idcccdeudor
        Dim idcccdeudor As IXMLDOMElement
        Set idcccdeudor = doc.createElement("Id")
        idcccdeudor.Text = "IBAN"
        cccdeudor.appendChild idcccdeudor
        'ibancccdeudor
        Dim ibancccdeudor As IXMLDOMElement
        Set ibancccdeudor = doc.createElement("IBAN")
        ibancccdeudor.Text = rs("REBic") & rs("RECodBanco") & rs("RECodSucursal") & rs("REDigitoControl") & rs("RENumCuenta")
        cccdeudor.appendChild ibancccdeudor
        
        
            cExplicacion = "" & rs("REExplicacion")
            cExplicacion = Replace(cExplicacion, "  ", " ") 'eliminamos los blancos seguidos de otro blanco
            cExplicacion = Left(cExplicacion, 140) 'Seleccionamos solamente los 140 primeros caracteres
            cExplicacion = CaracteresSEPA(cExplicacion)
            
        'concepto
        Dim Concepto As IXMLDOMElement
        Set Concepto = doc.createElement("RmtInf")
        infPagoDeudor.appendChild Concepto
        
        'concepto destructurado en txt
        Dim conceptotxt As IXMLDOMElement
        Set conceptotxt = doc.createElement("Ustrd")
        conceptotxt.Text = cExplicacion
        Concepto.appendChild conceptotxt
        
            ContadorRegIndividual = ContadorRegIndividual + 1
            contadorTotal = contadorTotal + 1

          
           
            nWaitIndex = nWaitIndex + 1
            rs.MoveNext
        Wend
        

        Set auxiliar = doc.selectSingleNode("//CtrlSum")
        auxiliar.Text = De_Num_a_Tx_01(FormatNumber(CDec(nImporteTotal), 2)) 'cantidad con punto y dos decimales

        Set auxiliar = doc.selectSingleNode("//CstmrDrctDbtInitn/PmtInf/CtrlSum")
        auxiliar.Text = De_Num_a_Tx_01(FormatNumber(CDec(nImporteTotal), 2)) 'cantidad con punto y dos decimales
        DestroyRS rs
        

        

      
      
    
    
                            
    End With
    
    
    
    
    'salvo archivo xml
    
        

    
    
        
    doc.Save (cFilename)
    MsgBox "Fichero XML generado OK. (" & nRecibos & " recibos.)" & vbCrLf
    nFileAction = 0
    
    

    
    On Error GoTo 0
    
ya:
    
    

    
    Set sb = Nothing
    'DestroyRS rs
    
    Exit Sub
    
eterr_saving:
    MsgBox "Error escribiendo fichero:" & vbCrLf & Err.Description, vbInformation + vbOKOnly, "Aviso:"

    Set sb = Nothing

End Sub

Function IdentificadorAcreedorPresentadorSpain(sufijo, Nif)
    'En Espaa el formato es este: ESZZXXXAAAAAAAAA, siendo:
    '    ES: cdigo del pas Espaa segn la norma ISO 3166
    '    ZZ: dgitos de control (cuyo clculo se explica a continuacin)
    '    XXX: sufijo (normalmente 000, pero el acreedor puede gestionar ms de un canal de adeudos poniendo otros valores)
    '    AAAAAAAAA: CIF del acreedor, frecuentemente una letra seguida de 8 cifras, sin espacios, guiones u otros smbolos.
    'Los dgitos de control se calculan en base al NIF, aplicando el modelo 97-10 (regla de clculo definida en la norma ISO 7604 y ampliamente usada en la norma ISO 20022, UNIFI).
    'Tomamos posiciones de la 8 a la 15, es decir el CIF, aadiendo ES y 00
    'Por ejemplo, en el caso de EADTrust, B85626240ES00
    'Convertimos letras a nmeros, considerando que la A es 10, la B es 11,  la E es 14,  la  S es 28,  hasta que la Z es 35.
    'Por ejemplo, en el caso de EADTrust, 1185626240142800
    'Aplicamos modelo 97-10 (dado un nmero, lo dividimos entre 97 y restamos a 98 el resto de la operacin. Si se obtiene un nico dgito, se completa con un cero a la izquierda)
    'Por ejemplo, en el caso de EADTrust, el resto de dividir 1185626240142800 entre 97 sale 21 y 98-21=77, por tanto el cdigo completo:  ES77000B85626240
    If Len(sufijo) < 3 Then
       sufijo = CerosIzda(sufijo, 3)
    End If
    Dim cadena As String
    Dim aux As String
    Dim X As Integer
    Dim DigitoControl As String
    Dim Resto As String
    
    cadena = Nif & "ES00"
    For X = 1 To Len(cadena)
         If Not IsNumeric(Mid(cadena, X, 1)) Then
           aux = aux & Letra_to_numero(Mid(cadena, X, 1))
         Else
           aux = aux & Mid(cadena, X, 1)
         End If
    Next
    DigitoControl = CerosIzda(98 - Mod97(aux), 2)
    IdentificadorAcreedorPresentadorSpain = "ES" & DigitoControl & sufijo & Nif
End Function

 Function Letra_to_numero(letra)
      Select Case UCase(letra)
          Case "A"
               Letra_to_numero = 10
          Case "B"
               Letra_to_numero = 11
          Case "C"
               Letra_to_numero = 12
          Case "D"
               Letra_to_numero = 13
          Case "E"
               Letra_to_numero = 14
          Case "F"
               Letra_to_numero = 15
          Case "G"
               Letra_to_numero = 16
          Case "H"
               Letra_to_numero = 17
          Case "I"
               Letra_to_numero = 18
          Case "J"
               Letra_to_numero = 19
          Case "K"
               Letra_to_numero = 20
          Case "L"
               Letra_to_numero = 21
          Case "M"
               Letra_to_numero = 22
          Case "N"
               Letra_to_numero = 23
          Case "O"
               Letra_to_numero = 24
          Case "P"
               Letra_to_numero = 25
          Case "Q"
               Letra_to_numero = 26
          Case "R"
               Letra_to_numero = 27
          Case "S"
               Letra_to_numero = 28
          Case "T"
               Letra_to_numero = 29
          Case "U"
               Letra_to_numero = 30
          Case "V"
               Letra_to_numero = 31
          Case "W"
               Letra_to_numero = 32
          Case "X"
               Letra_to_numero = 33
          Case "Y"
               Letra_to_numero = 34
          Case "Z"
               Letra_to_numero = 35
          End Select
  End Function

Function Mod97(ByVal vIban)
    Dim i, m, digit
    m = 0
    For i = 1 To Len(vIban)
        digit = CInt(Mid(vIban, i, 1))
        m = (10 * m + digit) Mod 97
    Next
    Mod97 = m
End Function
