Macro Excel Visual Basic. Importar varios ficheros XML a la vez
Tengo una macro para importar a una hoja de excel los datos de un fichero en formato .XML de una ruta. El caso es que a veces hay varios ficheros a importar. ¿Sería posible que se importaran todos juntos?
Este es el código que tengo para uno y funciona.
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False
'Crear una nueva hoja temporal
Worksheets.Add.Name = "TEMPORAL"
Dim FilePath As String
Dim Book As Workbook
'Load XML Data to New Workbook
FilePath = "\\MIRUTA\*.xml"
Set Book = Workbooks.OpenXML(FilePath)
'Copy to active Worksheet
Book.Sheets(1).UsedRange.Copy ThisWorkbook.Sheets("TEMPORAL").Range("A1")
Rows(1).EntireRow.Delete
'Close New Workbook
Book.Close False
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
ActiveSheet.DisplayPageBreaks = True
Application.CutCopyMode = False
Respuesta de Dante Amor
2
Prueba lo siguiente:
Sub importar_Xml()
Dim sPath As String, sFile As String
Dim Book As Workbook, sh As Worksheet
Dim lr As Long
'
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
.EnableEvents = False
.DisplayAlerts = False
ActiveSheet.DisplayPageBreaks = False
End With
'
'Crear una nueva hoja temporal
On Error Resume Next
Sheets("TEMPORAL").Delete
Worksheets.Add.Name = "TEMPORAL"
Set sh = ActiveSheet
On Error GoTo 0
'
'Load XML Data to New Workbook
sPath = "\\MIRUTA\"
sFile = Dir(sPath & "*.xml")
Do While sFile <> ""
Set Book = Workbooks.OpenXML(sPath & sFile)
Rows(1).Delete
If lr = 0 Then lr = 1 Else lr = sh.Cells.Find("*", , xlValues, 2, 1, 2).Row + 1
Book.Sheets(1).UsedRange.Copy sh.Range("A" & lr)
Book.Close False
sFile = Dir()
Loop
'
With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
.EnableEvents = True
.CutCopyMode = False
ActiveSheet.DisplayPageBreaks = True
End With
End Sub
