Automatically adding XML file name to its data when importing into Excel

Question

Excel 2013

Need to automatically import and combine thousands of xml files and add the applicable file name to each record in each file. I have mapped the fields in Excel.

Say I have file1.xml with 3 records, file2.xml with 2 records, file3.xml with 4 records, etc. Each file lists people's first and last names.

How do I create the Excel sheet below?

First Name	Last Name	File Name
John	Smith	file1.xml
Harold	Cameron	file1.xml
Hermione	Green	file1.xml
Ralph	Paladin	file2.xml
Nancy	Ferreira	file2.xml
Gwen	Levine	file3.xml
Michael	Iovino	file3.xml
Ariane	Jones	file3.xml
Biff	Harris	file3.xml

etc.

etc.

etc.

Answer 1

take a look above

APPEND XML DATA, AS TEXT, IN ONE SHEET

and

add the Filename in a new column to the right side.

xml files

result, like this picture

also,

try and this code

in order to delete All XML Maps

Sub DeleteXMLMaps()

Dim obj As XmlMap

For Each obj In ActiveWorkbook.XmlMaps

obj.Delete

Next obj

End Sub

Answer 2

I'm aiming for a single sheet (>240K records) in table form. 59 fields when file name is included. Doable?

Answer 3

Hi,

Thanks for responding so quickly.

Your code opened the first xml file and populated Excel with its records.

That's the good news.

Now for the issues:

1. Only the first record populated with the file name, instead of all records.
2. The code failed on the second file. When I ended up checking that file, I was surprised to find it was empty. If that is the reason for the failure, and not knowing if there are other empty files, it looks like the code needs to test for that and move on if that happens. (If heading-only xml files can exist and would cause code failure, perhaps test for and skip those as well?)
3. I provided the fictitious 3-field example only so it would fit in the window and display what I was looking for (file name in last field for each record in a consolidated table). The number of fields in each actual file varies between 52-58. That first file has 57 fields. The field order may vary as well; but field names have been constant. Even though I was able to create XML source mapping in my Excel file that automatically adjusted for the varying field counts/order and allows all the files to be correctly imported into a single table, I still need a way to automatically include the corresponding VITAL file name in each record being imported.

Can you help?

Answer 4

Hi,

APPEND XML DATA, AS TEXT, IN ONE SHEET

Sub Append_XML_to_EXCEL_text()

'Dec 05, 2015

Dim sPath

sPath = "C:\Users\Username\Desktop\Folder XML"    '<< change path

Dim sFile

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

Dim r As Long, c As Long, x As Long, t As Long, L As Long

t = 0

Application.ScreenUpdating = False

Application.DisplayAlerts = False

Set sht = Sheets.Add

Do Until sFile = ""

t = t + 1

sht.Cells(t, 1).Value = sFile

sFile = Dir()

Loop

L = t

t = 1

Dim rng As Range

Sheets.Add

For x = 1 To L

sFile = sht.Cells(x, 1).Value

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

r = ActiveSheet.Cells(t, 1).CurrentRegion.Rows.Count

c = ActiveSheet.Cells(t, 1).CurrentRegion.Columns.Count

Cells(t, c + 1).Value = "File Name"

Cells(t + 1, c + 1).Resize(r - 1).Value = sFile

'#####################

Set rng = ActiveSheet.Cells(t, 1).CurrentRegion

ActiveSheet.ListObjects(1).Unlist

With rng

.Borders(xlEdgeLeft).LineStyle = xlNone

.Borders(xlEdgeTop).LineStyle = xlNone

.Borders(xlEdgeBottom).LineStyle = xlNone

.Borders(xlEdgeRight).LineStyle = xlNone

.Borders(xlInsideVertical).LineStyle = xlNone

.Borders(xlInsideHorizontal).LineStyle = xlNone

With .Interior

.Pattern = xlNone

.TintAndShade = 0

.PatternTintAndShade = 0

End With

With .Font

.ColorIndex = xlAutomatic

.Bold = False

.TintAndShade = 0

End With

End With

'####################

t = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row + 2

Next

sht.Delete

With ActiveSheet.UsedRange

.HorizontalAlignment = xlCenter

.VerticalAlignment = xlCenter

.EntireColumn.AutoFit

End With

[A1].Select

Application.DisplayAlerts = True

Application.ScreenUpdating = True

End Sub