Imprimir página | Cerrar ventana

Leer XML

Impreso de: Foro de Access y VBA
Categoría: Access y VBA
Nombre del foro: Access y VBA
Descripción del foro: Foro de programacion en Access (Con código y sin código)
URL: http://www.mvp-access.com/foro/forum_posts.asp?TID=86713
Fecha de impresión: 26/Marzo/2026 a las 15:17


Tema: Leer XML
Publicado por: rokoko
Asunto: Leer XML
Fecha de publicación: 05/Junio/2023 a las 18:35
Hola.

Tratando de leer un XML en access llegue a un ejemplo de Mihura.
http://www.accessaplicaciones.com/ejemplos.html





'--------------------------------------------------
'Empezamos a leer el XML

Dim xDoc As MSXML2.DOMDocument60
Dim Xs As String, i As Integer
Dim Rs As DAO.Recordset

    '* los comentarios más amplios en la rutina anterior
    
    '* inicializamos las variables
    Erase Tabla
    CuentaEle = 0
    TextoInicial1 = "CstmrDrctDbtInitn": TextoInicial2 = "CdtrSchmeId"
    
    '* leemos el archivo que queremos analizar
    Set xDoc = New MSXML2.DOMDocument60
    xDoc.Load (Me.txtXML)
    LeerNodos xDoc.ChildNodes
    Set xDoc = Nothing



    '* comenzamos el tratamiento del texto recibido
    
    '* lo primero buscamos desde/hasta de los datos generales
    DesdeHasta "CstmrDrctDbtInitn", 1
        If Desde = 0 Then
            MsgBox "Error formato fichero", vbCritical, Me.Caption
            Exit Sub
        End If
        ' mostramos los datos que necesitemos
        Me.Datos = "Acreedor: " & BuscaValor("Nm") & vbNewLine & _
                   "Nombre remesa: " & BuscaValor("MsgId") & vbNewLine & _
                   "Fecha de cargo: " & Format(BuscaValor("ReqdColltnDt"), "dd/mm/yyyy") & vbNewLine & _
                   "Nº Operaciones: " & BuscaValor("NbOfTxs") & vbNewLine & _
                   "Importe remesa: " & BuscaValor("CtrlSum") & "€"
                   'HASTA  AQUI SACA LO QUE QUIERO; PERO EL BUCLE DE ABAJO NO LO CONSIGO
                   '* como pueden venir varios adeudos lo hacemos mediante un bucle
    
    Do
        '* lo primero buscamos desde/hasta de la cabecera del adeudo
        Call DesdeHasta("DrctDbtTxInf", Hasta + 1)
            If Desde = 0 Then Exit Do  ' significa que ya no hay más pedidos
            ' mostramos los datos que necesitemos
            
            MsgBox "Nº Recibo:      " & BuscaValor("EndToEndId")
            Me.Datos = Me.Datos & vbNewLine & vbNewLine & _
                       "Nº Recibo:      " & BuscaValor("EndToEndId") & vbNewLine & _
                       "Importe:          " & BuscaValor("InstdAmt") & "€" & vbNewLine & _
                       "Nombre cliente: " & BuscaValor("Nm") & vbNewLine & _
                       "Iban: " & BuscaValor("IBAN") & vbNewLine & _
                       "Concepto: " & BuscaValor("Ustrd")
    Loop

    MsgBox "Proceso terminado"

Y el XML Tiene esta estructura

<Document xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xmlns="urn:iso:std:iso:20022:tech:xsd:pain.008.001.02">
<CstmrDrctDbtInitn>
<GrpHdr>
<MsgId>Abo2023-05-30T8:17:24</MsgId>
<CreDtTm>2023-05-30T08:17:24</CreDtTm>
<NbOfTxs>2</NbOfTxs>
<CtrlSum>2.2</CtrlSum>
<InitgPty>
<Nm>Fondo(Pepe Palotes)</Nm>
<Id>
<OrgId>
<Othr>
<Id>ES190003341</Id>
</Othr>
</OrgId>
</Id>
</InitgPty>
</GrpHdr>
<PmtInf>
<PmtInfId>Abo2023-05-30T - RCUR - 2023-05-30</PmtInfId>
<PmtMtd>DD</PmtMtd>
<NbOfTxs>2</NbOfTxs>
<CtrlSum>2.2</CtrlSum>
<PmtTpInf>
<SvcLvl>
<Cd>SEPA</Cd>
</SvcLvl>
<LclInstrm>
<Cd>CORE</Cd>
</LclInstrm>
<SeqTp>RCUR</SeqTp>
</PmtTpInf>
<ReqdColltnDt>2023-06-05</ReqdColltnDt>
<Cdtr>
<Nm>Fondo(Pepe Palotes)</Nm>
</Cdtr>
<CdtrAcct>
<Id>
<IBAN>ES633035014567</IBAN>
</Id>
</CdtrAcct>
<CdtrAgt>
<FinInstnId>
<BIC>CLPEES2MXXX</BIC>
</FinInstnId>
</CdtrAgt>
<CdtrSchmeId>
<Id>
<PrvtId>
<Othr>
<Id>ES1900033419</Id>
<SchmeNm>
<Prtry>SEPA</Prtry>
</SchmeNm>
</Othr>
</PrvtId>
</Id>
</CdtrSchmeId>
<DrctDbtTxInf>  'AQUI EMPEZARIAN LOS DEUDORTES, EN ESTE CASO HAY 2
<PmtId>
<EndToEndId>-5715</EndToEndId>
</PmtId>
<InstdAmt Ccy="EUR">1.1</InstdAmt>
<DrctDbtTx>
<MndtRltdInf>
<MndtId>216</MndtId>
<DtOfSgntr>2022-11-23</DtOfSgntr>
</MndtRltdInf>
</DrctDbtTx>
<DbtrAgt>
<FinInstnId>
<BIC>INGDESMMXXX</BIC>
</FinInstnId>
</DbtrAgt>
<Dbtr>
<Nm>Juuan Perez</Nm>
</Dbtr>
<DbtrAcct>
<Id>
<IBAN>ES63146501009</IBAN>
</Id>
</DbtrAcct>
<RmtInf>
<Ustrd>Fondo_2023</Ustrd>
</RmtInf>
</DrctDbtTxInf>
<DrctDbtTxInf>
<PmtId>
<EndToEndId>-5717</EndToEndId>
</PmtId>
<InstdAmt Ccy="EUR">1.1</InstdAmt>
<DrctDbtTx>
<MndtRltdInf>
<MndtId>117</MndtId>
<DtOfSgntr>2022-11-23</DtOfSgntr>
</MndtRltdInf>
</DrctDbtTx>
<DbtrAgt>
<FinInstnId>
<BIC>BCOEESMM008</BIC>
</FinInstnId>
</DbtrAgt>
<Dbtr>
<Nm>Mikel Felipe</Nm>
</Dbtr>
<DbtrAcct>
<Id>
<IBAN>ES183008000111</IBAN>
</Id>
</DbtrAcct>
<RmtInf>
<Ustrd>Fondo_2023</Ustrd>
</RmtInf>
</DrctDbtTxInf>
</PmtInf>
</CstmrDrctDbtInitn>
</Document>


Saludos



Respuestas:
Publicado por: Mihura
Fecha de publicación: 05/Junio/2023 a las 21:22
La cuestión es que estás buscando datos en el bloque DrctDbtTxInf y todos los datos que buscas están en ese bloque por lo que sólo te muestra un recibo.

Dile que busque por PmtId que es el primer valor de cada recibo y verás como furula bien.

Créate el auxiliar y mira como construye los elementos de la tabla (claves y valores) te ayudará mucho a la hora se seguir el proceso).

De todas maneras, ya te recomendaría que en vez de usar este método uses el DOM puro, el ejemplo está en el segundo formulario.

 


-------------
Jesús Mansilla Castells.
Saludos desde Móstoles.

http://www.accessaplicaciones.com" rel="nofollow - Access Aplicaciones
http://www.tecsys.es" rel="nofollow - Tecsys.es


Publicado por: rokoko
Fecha de publicación: 08/Junio/2023 a las 18:31
Buenas!!
Pues me he puesto a trabajar con ese segundo formulario de Mihura, y es mas facil.
Pero me estaba volviendo loco el porque no funcionaba, es seguir las jerarquias de la etiqueras de XML.
Mi XML tiene esta primera linea, es un SEPA
<Document xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xmlns="urn:iso:std:iso:20022:tech:xsd:pain.008.001.02">

Pero solo funciona si tiene esta, una sola xmlns , como en el ejemplo de Mihura
<Document xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance">

Por que??  y En el archivo SEPA las dos lineas xmlns son necesarias o solo con una vale???


Saludos


Publicado por: emiliove
Fecha de publicación: 08/Junio/2023 a las 18:42
Busca y por ahí Jesús tiene como limpiar cabecera, buscalo.

Saludos.


Publicado por: rokoko
Fecha de publicación: 08/Junio/2023 a las 18:49
Aqui esta, lo probare..

Arreglo (limpieza) de cabeceras XML

Se supone que se creó el estándard XML para evitar estar haciendo el panoli con los ficheros que se envían y reciben, pero no, hay que complicar las cosas, no sea que nos vayamos a aburrir. En principio he detectado dos tipos de 'errores' en la cabecera que provocan que la lectura con DOM no funcione bien.

Puede ser la inclusión de un literal inesperado o la incorrecta codificación del modificador de la clave:
    xmlns="http://www.w3.org/2001/XMLSchema-instance

- en vez del correcto:
    xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance

Para evitar este error se puede seguir el método de usar una hoja de estilo, como propone Emiliove en este hilo del foro mvp-access:  http://www.mvp-access.com/foro/topic82048_post494251.html" rel="nofollow - Hilo Foro mvp-access.com

O bien, usar un método más simple que nos modifique manualmente la clave afectada (limpiándola)



El tratamiento del fichero XML cambiaría de esto:


Private Sub CmdSelCodigoA_Click()
Dim xNodes As MSXML2.IXMLDOMNodeList
Dim xNode As IXMLDOMNode
    
     Set xDoc = New MSXML2.DOMDocument60
     xDoc.async = False
     xDoc.Load (CurrentProject.Path & "\prueba.xml")
    
     Set xNodes = xDoc.selectNodes("//NombreNodo")
     For Each xNode In xNodes
         Debug.Print xNode.Text
     Next
     Set xDoc = Nothing
End Sub



a esto:


Private Sub CmdSelCodigoA_Click()
Dim Xs As String
Dim xNodes As MSXML2.IXMLDOMNodeList
Dim xNode As IXMLDOMNode
    
     Set xDoc = New MSXML2.DOMDocument60
     xDoc.async = False
     xDoc.Load (CurrentProject.Path & "\prueba.xml")
    
     Xs = xDoc.XML
     Xs = RT_LimpiarCabXML(Xs, "ServiceRequest")
     xDoc.loadXML Xs
    
     Set xNodes = xDoc.selectNodes("//MobilePhone")
     For Each xNode In xNodes
         Debug.Print xNode.Text
     Next
     Set xDoc = Nothing
End Sub




Function RT_LimpiarCabXML(StringXml As String, Clave As String) As String
Dim i As Integer, j As Integer
     i = InStr(1, StringXml, Clave & " ")
     j = InStr(i, StringXml, ">")
     RT_LimpiarCabXML = Mid$(StringXml, 1, i + Len(Clave)) & Mid$(StringXml, j)
End Function



El resultado obtenido es (antes y después):




Como se ve en el código expuesto, a la rutina de limpieza hay que pasarle el nombre de la clave que queremos limpiar, en este caso ServiceRequest.





Publicado por: rokoko
Fecha de publicación: 08/Junio/2023 a las 19:05
Pues parece que funciona. He limpiado la cabecera, la 1º etiqueta llamada Document del XML SEPA.
Tiene miga esto de los XML, a mi me supera, pero con los ejemplos voy apañando y aprendiendo un poco.

Hago alguna prueba mas...

Muchas gracias


Publicado por: rokoko
Fecha de publicación: 10/Junio/2023 a las 08:14
Hola.

Se puede cerrar!  Muchas gracias

Saludos



Imprimir página | Cerrar ventana