XML map to import multiple XML data files

Hi,

Assuming that all files are on desktop, in a folder  fd xml

Option1

import all xml files without xml maps in a new sheet named: append-data

try this code

Sub Load_XML_files()

 'Jan 28, 2017

Const sName$ = "append-data"

Dim wb As Workbook, wb1 As Workbook

Set wb = ThisWorkbook

Dim newSht As Worksheet, sh As Worksheet

Dim sPath

sPath = "C:\Users\Tasos\Desktop\fd xml" '<< change path

Dim sFile

Dim L As Long

Application.ScreenUpdating = False

Application.DisplayAlerts = False

For Each sh In wb.Worksheets

If sh.Name = sName Then sh.Delete

Next

Set newSht = wb.Sheets.Add

newSht.Name = sName

sFile = Dir(sPath & "*.xml")

L = 1

Do Until sFile = ""

Set wb1 = Workbooks.OpenXML(Filename:=sPath & sFile, LoadOption:=xlXmlLoadImportToList)

With newSht

wb1.Sheets(1).UsedRange.Copy .Cells(L, 1)

wb1.Close False

.ListObjects(1).Range.AutoFilter

.ListObjects(1).Unlist

If L > 1 Then .Cells(L, 1).EntireRow.Delete

L = .Cells(Rows.Count, 1).End(xlUp).Row + 1

End With

sFile = Dir()

Loop

newSht.Range("A1").CurrentRegion.Interior.Pattern = xlNone

newSht.ListObjects.Add(xlSrcRange, newSht.Range("A1").CurrentRegion, , xlYes).Name = "Tbl_01"

wb.Save

Application.DisplayAlerts = True

Application.ScreenUpdating = True

End Sub

XXXXXXXXXXXXXXXXXXXXXXXXXX

Option2

import all xml files with xml maps in a new sheet named: append-data

Sub Load_XML_filesMap()

  'Jan 28, 2017

 Const sName$ = "append-data"

 Dim wb As Workbook

 Set wb = ThisWorkbook

 Dim newSht As Worksheet, sh As Worksheet

 Dim sPath

 sPath = "C:\Users\Tasos\Desktop\fd xml" '<< change path

 Dim sFile

 Dim L As Long

 Application.ScreenUpdating = False

 Application.DisplayAlerts = False

 For Each sh In wb.Worksheets

 If sh.Name = sName Then sh.Delete

 Next

 Set newSht = wb.Sheets.Add

 newSht.Name = sName

'

 'delete old XMLMaps ###

Dim obj As XmlMap

For Each obj In ActiveWorkbook.XmlMaps

obj.Delete

Next obj

' ###

'

 sFile = Dir(sPath & "*.xml")

 L = 1

 Do Until sFile = ""

ActiveWorkbook.XmlImport URL:=sPath & sFile, ImportMap:=Nothing, Overwrite:=True, Destination:=newSht.Cells(L, 1)

L = newSht.Cells(Rows.Count, 1).End(xlUp).Row + 2

 sFile = Dir()

 Loop

 wb.Save

 Application.DisplayAlerts = True

 Application.ScreenUpdating = True

 End Sub