¿Cómo extraer el dato de varios archivos XML de un campo en particular y copiarlos en una celda?
Tengo una carpeta con aproximadamente 3.000 archivos xml. Al abrir uno de ellos en excel, eligo la opción de abrir "como libro de sólo lectura" y se genera una tabla, donde puedo visualizar el campo que necesito extraer: "CodigoTipoDocumento". Esta tabla posee 2 filas, en la primera donde aparecen los nombres de los campos y la segunda el valor para cada campo respectivo.
Lo que necesito es una macro, que lea todos los archivos existentes en la carpeta (3.000), que los abra temporalmente, que extraiga el valor del campo "CodigoTipoDocumento", y que llene en una planilla estos valores. Por ende, la nueva planilla debería tener 1 columna y 3.000 filas con los respectivos valores.
Checa esta lista de reproducción, es un curso de XML con VBA para que puedas la información de tus XML mediante una serie de Macros. https://www.youtube.com/playlist?list=PLngkFhMb1oJrVsrvXLY3v1M1IzJExjDSU Suscríbete, dale like a los vídeos, comparte, comenta. La lista de reproducción se actualiza constantemente.
1 respuesta más de otro experto
Me puedes enviar 3 archivos:
- Dos archivos ejemplo de xml
- Un archivo "plantilla" de cómo quieres el resultado, con los 2 datos extraídos de los 2 archivos ejemplo.
Creo la macro y te la envío.
Mi correo [email protected]
En el asunto del correo escribe tu nombre de usuario “” y el título de esta pregunta.
Estimado, he realizado el envío de la información solicitada.
Gracias de antemano.
Saludos!
Te anexo la macro
Sub AbrirXlm()
'Por.Dante Amor
'
Set l1 = ThisWorkbook
Set h1 = l1.Sheets("plantilla")
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 SubSaludos.Dante Amor