Macro para extraer datos de varios XML a Excel
Necesito una macro que extraiga algunos datos de varios .XML contenidos en un carpeta. He encontrado en este foro, pero solo lo hace de forma individual.
Ayuda!
1 Respuesta
Tengo algunas respuestas que tienen un ciclo para abrir varios archivos, revisa para que la adaptes a tu necesidad:
Extraer datos específicos de un xml (campos repetidos)
Mira, seria algo más o menos con esta estructura:
Sub AbrirXlm()
'Por.Dante Amor
'
Set l1 = ThisWorkbook
Set h1 = l1.Sheets("Database")
ruta = l1.Path
Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
With fldr
.Title = "Selecciona una carpeta"
.AllowMultiSelect = False
.InitialFileName = ruta & "\"
If .Show <> -1 Then Exit Sub
cp = .SelectedItems(1)
End With
'
Application.ScreenUpdating = False
ChDir cp & "\"
archi = Dir("*.xml")
n = 1
Do While archi <> ""
Application.StatusBar = "Procesando archivo: " & n
Set l2 = Workbooks.Open(Filename:=archi)
Set h2 = l2.ActiveSheet
u = h1.Range("A" & Rows.Count).End(xlUp).Row + 1
h1.Cells(u, "A") = h2.Name
h1.Cells(u, "B") = h2.[B3]
h1.Cells(u, "C") = h2.[C3]
l2.Close False
archi = Dir()
n = n + 1
Loop
Application.ScreenUpdating = True
Application.StatusBar = False
MsgBox "Proceso terminado"
End Sub
Para este caso no he podido complementar los valores que se buscan en los archivos .XML ya que en el ejemplo busca valores fijos y necesito que busque valores variables (que pueden estar en cualquier celda). Había pensado en los códigos IL Case, If o Else
Puedes poner imágenes de lo que quieres buscar y en dónde lo quieres poner.
Quiero que busque estos datos en todos los XML (que son como 700) que están en una sola carpeta:
> /cfdi:Emisor/@rfc
> /@fecha
> /cfdi:Complemento/tfd:TimbreFiscalDigital/@UUID
Y que estos datos los coloque en:
- Columna A = RFC
- Columna B = FECHA
- Columna C = UUID
Por favor, gracias.
Abre un archivo xml desde excel y pon una imagen de la hoja para ver en qué fila están los encabezados y en cuál fila los datos, generalmente es la fila 2 y 3.
Prueba con la siguiente macro:
Sub AbrirXlm()
'Por.Dante Amor
'
Set l1 = ThisWorkbook
Set h1 = l1.Sheets("Database")
ruta = l1.Path
Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
With fldr
.Title = "Selecciona una carpeta"
.AllowMultiSelect = False
.InitialFileName = ruta & "\"
If .Show <> -1 Then Exit Sub
cp = .SelectedItems(1)
End With
'
datos = Array("/cfdi:Emisor/@rfc", _
"/@fecha", _
"/cfdi:Complemento/tfd:TimbreFiscalDigital/@UUID")
'
Application.ScreenUpdating = False
ChDir cp & "\"
archi = Dir("*.xml")
j = 2
Do While archi <> ""
k = 1
Application.StatusBar = "Procesando archivo: " & n
Set l2 = Workbooks.Open(Filename:=archi)
Set h2 = l2.ActiveSheet
u = h1.Range("A" & Rows.Count).End(xlUp).Row + 1
For i = LBound(datos) To UBound(datos)
Set b = h2.Rows(2).Find(datos(i), lookat:=xlPart)
If Not b Is Nothing Then
h1.Cells(j, k) = h2.Cells(3, b.Column)
k = k + 1
End If
Next
l2.Close False
j = j + 1
archi = Dir()
Loop
Application.ScreenUpdating = True
Application.StatusBar = False
MsgBox "Proceso terminado"
End Sub[' Si es lo que necesitas. No olvides valorar la respuesta.
