VBA: Trabajando con XML

Repasaremos hoy algunas formas de trabajar con ficheros XML desde VBA en Excel... ya sabes que este tipo de archivos XML están basados en datos estructurados mediante etiquetas, y son bastante habituales a la hora de traspasar información.

Así pues, en este artículo dejaré algunas macros que nos permitirán:
- Crear un fichero XML a partir de una tabla de Excel.
- Anexar un conjunto de archivos XML en uno solo.
- Importar un archivo XML a una hoja de Excel.
- Obtener el mapa de un archivo XML.

Partiremos de una tabla, llamada 'TblVENTAS' contenida en una hoja de nuestro libro...

Es una tabla estándar de Excel con seis campos: 'Fecha','Pais','Producto','Unidades','Precio unitario' y 'Total'.

Comencemos creando un archivo XML con el contenido de una tabla en Excel.
En un módulo estándar insertaremos el siguiente código:

Sub ExportaTablas_ToXML()

Dim strXML As String
Dim iFila As Long, iCol As Long
Dim vTabla As Variant, vEncab As Variant

'para las etiquetas de Tabla y fila
Dim sNombreEltoTabla As String
Dim sNombreEltoFila As String
sNombreEltoTabla = "tabla"
sNombreEltoFila = "fila"

Dim ruta As String, fecha As Variant
'Ruta del fichero a generar
ruta = "F:\excelforo\XML_test\fuentes"
fecha = "y" & Year(CDate(Hoja1.Range("A2").Value))

'Carga de datos...
vTabla = Hoja1.ListObjects("TblVENTAS").DataBodyRange.Value
vEncab = Hoja1.ListObjects("TblVENTAS").HeaderRowRange.Value

Dim sRutaArchivoXML As String
sRutaArchivoXML = ruta & "\" & fecha & ".xml"

'construimos el xml
'En un documento XML no es obligatorio que aparezca la declaración XML
'Si se escribe, el atributo version es obligatorio indicarlo.
'los atributos encoding y standalone son opcionales y,
'por defecto, sus valores son "UTF-8" y "no", respectivamente.
'standalone="yes" se está indicando que el documento es independiente de otros

'recorremos cada fila y cada columna de la tabla,
'concatenando valores con 'etiquetas' del XML
'alternado su apertura y cierre de los nodos....
strXML = "<!--?xml version=""1.0"" encoding=""UTF-8""?-->"  'standalone=""yes""
strXML = strXML & "<" & sNombreEltoTabla & ">"
For iFila = 1 To UBound(vTabla, 1)
    strXML = strXML & "<" & sNombreEltoFila & ">"
    For iCol = 1 To UBound(vTabla, 2)
        strXML = strXML & "<" & CStr(Replace(vEncab(1, iCol), " ", "_")) & ">" & _
            vTabla(iFila, iCol) & "</" & CStr(Replace(vEncab(1, iCol), " ", "_")) & ">"
    Next iCol
    strXML = strXML & "</" & sNombreEltoFila & ">"
Next iFila
strXML = strXML & "</" & sNombreEltoTabla & ">"

'Para generar el fichero nuevo de XML
Dim iNumArchivo As Long
'obtenemos el valor del siguiente archivo libre a crear
iNumArchivo = FreeFile

'lo abrimos, cargamos con print(o write) y cerramos
Open sRutaArchivoXML For Output As #iNumArchivo
Print #iNumArchivo, strXML
Close #iNumArchivo

MsgBox "XML Creado"
End Sub

El resultado será un archivo .xml con este aspecto:

Notemos cómo se han cargado las fechas... su formato es mm/dd/yyyy.

Con el siguiente código conseguimos anexar o juntar en un solo archivo .xml varios ficheros.
Trabajaremos sobre un conjunto de ficheros .xml guardados en una misma carpeta, y por supuesto un mismo mapa. En un módulo estándar del editor de VBA insertamos el siguiente procedimiento:

Sub AnexaXMLs()
Dim rutaCarpetaXMLs As String

Dim inDoc As New MSXML2.DOMDocument60
Dim XMLFinal As New MSXML2.DOMDocument60
Dim rdo As Object, nd

'creamos un Elemento o nivel superior que englobará todos los nodos
'de los distintos archivos...
Set rdo = XMLFinal.appendChild(XMLFinal.createElement("anexado"))
'ruta carpeta donde estén los XML
rutaCarpetaXMLs = "F:\excelforo\XML_test\fuentes\"

Dim archivoXML As Variant

archivoXML = Dir(rutaCarpetaXMLs)
'recorremos la carpeta que contiene los XML
'fichero por fichero
While (archivoXML <> "")
    'cargamos con el método GET el contenido de cada fichero
   Dim XMLSolicitud As New MSXML2.XMLHTTP60
   With XMLSolicitud
        .Open "GET", rutaCarpetaXMLs & archivoXML, False       ',usuario, password
        .setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/59.0.3071.115 Safari/537.36"
        .setRequestHeader "Content-Type", "application/xml"
        .send
       'en realidad esto es una herramienta de acceso web
        Dim HTMLDocumento As New MSHTML.HTMLDocument
        HTMLDocumento.body.innerHTML = .responseText
    End With
    'pasamos el contenido a una funcionalidad XML
    'que identificará nodos, elementos, etc..
    inDoc.LoadXML (HTMLDocumento.body.innerHTML)
    Set nd = XMLFinal.importNode(inDoc.DocumentElement, True)
    rdo.appendChild nd

    archivoXML = Dir
Wend


'con el XML compuesto, procedemos a crear un nuevo XML global/consolidado
Dim sNombreficheroFinal As String
sNombreficheroFinal = "F:\excelforo\XML_test\Consolidado2009-2021.xml"

'Cerramos cualquier fichero de texto abierto
Close
'conseguimos el siguiente número de fichero libre
Dim numArchivoDestino As Long
numArchivoDestino = FreeFile

' escribimos el texto en el fichero
Open sNombreficheroFinal For Output As #numArchivoDestino
Print #numArchivoDestino, XMLFinal.XML
'y lo cerramos
Close #numArchivoDestino

Set XMLSolicitud = Nothing
Set nd = Nothing
Set rdo = Nothing
End Sub

El resultado es un único fichero .xml que contiene toda la información de los .xml de nuestra carpeta:

Podrías preguntarte.. ¿por qué anexar los distintos ficheros .xml?... el motivo es que a la hora de trabajar con ellos desde Power Query, el proceso es más rápido y ágil ;-)

El siguiente proceso trata de cómo importar un fichero .xml en una hoja de Excel... pero sin traerse el mapa XML consigo!!.
Para ello insertamos un nuevo procedimiento Sub en un módulo estándar:

Sub ImportarXMLaExcel()
Dim xDoc As MSXML2.DOMDocument60
Dim xResult As MSXML2.IXMLDOMNode
Dim xEntry As MSXML2.IXMLDOMNode
Dim xChild As MSXML2.IXMLDOMNode
Dim xTag As MSXML2.IXMLDOMNode

Dim Col As Integer, Fila As Integer

Set xDoc = New MSXML2.DOMDocument60
xDoc.async = False
xDoc.validateOnParse = False
'recuperamos el fichero .xml resultante del anexado anterior
xDoc.Load ("F:\excelforo\XML_test\Consolidado2009-2021.xml")

Set xResult = xDoc.DocumentElement
Set xEntry = xResult.FirstChild

Col = 1: Fila = 1
'recorremos los niveles distintos de nuestros nodos
'en nuestro ejemplo son tres niveles: tabla, fila, etiquetas (fecha, pais, producto, ....)
For Each xEntry In xResult.ChildNodes
    For Each xChild In xEntry.ChildNodes
        Col = 1
        For Each xTag In xChild.ChildNodes
            'trasladamos el dato a la hoja 3
            If xTag.nodeName = "fecha" Then
                Sheets("Hoja3").Cells(Fila, Col).Value = CDate(xTag.Text)
            ElseIf IsNumeric(xTag.Text) = True Then
                Sheets("Hoja3").Cells(Fila, Col).Value = CDbl(xTag.Text)
            Else
                Sheets("Hoja3").Cells(Fila, Col).Value = xTag.Text
            End If
            Col = Col + 1
        Next xTag
        Fila = Fila + 1
    Next xChild
Next xEntry

End Sub

Podemos ver el resultado cargado en la hoja...

Y finalmente toca obtener el mapa XML de un fichero.
En un nuevo módulo estándar añadimos el siguiente procedimiento.

Sub MAPS_XML()
Dim strMyXML As String
'ruta del fichero .xml
strMyXML = "F:\excelforo\XML_test\Consolidado2009-2021.xml"

'añadimos el mapa al fichero!!
'lo interesante es que el texto ppodrá ser guardado en un fichero .xsd (mapas de XML)
Dim myMap As XmlMap
Set myMap = ThisWorkbook.XmlMaps.Add(strMyXML)

Application.DisplayAlerts = True

Dim myXSD As String
'obtenemos la cadena del mapa en formato .xsd
myXSD = ThisWorkbook.XmlMaps(1).Schemas(1).XML

'devolvemmos los datos a la ventana de inmediato
Debug.Print myXSD
'devolvemmos los datos a la hoja
Sheets("Hoja2").Range("A1").Value = myXSD

'acabamos borrando el mapa, para no cargar el fichero innecesariamente
myMap.Delete
Set myMap = Nothing
End Sub

Y terminamos viendo el resultado: