Listar archivos xml y conservar estatus histórico en excel
En ocasiones pasadas tuve que hacer dos macros, una para listar los datos dentro de varios xml dentro de una carpeta y otra para listar todos los xml de una carpeta con sub-carpetas.
Ahora necesito ayuda para hacer un tipo de reporte que tome de una carpeta y sub-carpetas, específicamente este directorio:
Dentro de las carpetas numeradas van los xml y pdf de la semana correspondiente.
La idea es que en la hoja de excel se listen los datos de los xml como UUID, FECHA, RFC Emisor, RFC receptor, TOTAL. Algo así...
El mayor reto (supongo) es: conservar el estatus de cada xml en la columna "J", también que se ponga la información del xml en cada columna si es posible como se muestra en la imagen, (si lo segundo no es posible acepto sugerencias).
Que cuando el archivo se actualice con nuevos XML el encargado de revisar el archivo pueda cambiar el estado de cada xml según el proceso que lleve.
Actualmente no he podido modificar estas macros para que lo haga y estoy desesperándome!
Les agradezco su ayuda desde ya!
Código utilizado hasta ahora:
Option Explicit
Sub ListarArchivos()
'DECLARACION DE VARIABLES
Dim iFile, mPath, iRow(1 To 1, 1 To 6), xmlDoc, Tmp
iFile = Application.GetOpenFilename("Archivos XML (*.xml), *.xml")
If iFile = False Then Exit Sub
Application.ScreenUpdating = False
mPath = Left(iFile, InStrRev(iFile, "\")): iFile = Dir(mPath & "*.xml")
Set xmlDoc = CreateObject("MSXML2.DOMDocument.6.0") ' XML v6.0
Do
iRow(1, 1) = iFile
xmlDoc.Load mPath & iRow(1, 1)
'-----
'UUID:
Set Tmp = xmlDoc.getElementsByTagName("tfd:TimbreFiscalDigital").Item(0).Attributes.getNamedItem("UUID")
iRow(1, 2) = Tmp.Value
'------
'Fecha:
Set Tmp = xmlDoc.getElementsByTagName("cfdi:Comprobante").Item(0).Attributes.getNamedItem("fecha")
iRow(1, 3) = CDate(Replace(Tmp.Value, "T", " "))
'----------
'RFC Emisor:
Set Tmp = xmlDoc.getElementsByTagName("cfdi:Emisor").Item(0).Attributes.getNamedItem("rfc")
iRow(1, 4) = Tmp.Value
'RFC Receptor:
Set Tmp = xmlDoc.getElementsByTagName("cfdi:Receptor").Item(0).Attributes.getNamedItem("rfc")
iRow(1, 5) = Tmp.Value
'-----
'Total:
Set Tmp = xmlDoc.getElementsByTagName("cfdi:Comprobante").Item(0).Attributes.getNamedItem("total")
iRow(1, 6) = Val(Tmp.Value)
Cells(Rows.Count, "a").End(xlUp).Offset(1).Resize(, 6) = iRow
iFile = Dir
Loop Until iFile = ""
Application.ScreenUpdating = True
End Sub
