How to import multiple xml file into excel

TasosK,

This is an awesome string, I have learned a lot. 

However, the code I really need is in a message that has been deleted.  I am looking for, "Import multiple XML into a single Excel sheet with a single header".  I believe you were the one who initially provided it and others report using it with great success, unfortunately I can't see the code.

If you are able could you please repost that code??

Thanks!!

David

JDubinsky

You, and others, reference the code to "import hundreds of .xml files into excel with only one header" but the message that included the code has been deleted.

Will you please re-share the code to do that?  I've got everything figured out except being able to limit all of the xml files to one single header once in Excel.

Thanks in advance!!

David

[update: March 15, 2016]

To whom it may concern... (1)

Import xml files in active workbook, each xml in a new sheet

(all xml files in one folder)

in the below vba macro:

step1

delete all  '.xml' sheets

step2

delete all xmlmaps

step3

import all xlm files

Sub Import_XML_001()

'Mar 13, 2016

Dim sPath

sPath = "C:\Users\Username\Desktop\Folder XML" '<< change path. All xml files in <folder XML>

Dim sFile

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

Application.ScreenUpdating = False

Application.DisplayAlerts = False

'

'SECTION 1 delete 'old' xml sheets ###

Dim sh As Worksheet

For Each sh In Sheets

If sh.Name Like "*.xml*" Then sh.Delete

Next

'END SECTION 1 ###

'

'SECTION 2 delete XMLMaps ###

Dim obj As XmlMap

For Each obj In ActiveWorkbook.XmlMaps

obj.Delete

Next obj

'END SECTION 2 ###

'

'SECTION 3 import xml files ###

Do Until sFile = ""

Set sht = Sheets.Add

ActiveSheet.Name = sFile

ActiveWorkbook.XmlImport URL:=sPath & sFile, ImportMap:=Nothing, Overwrite:=True, Destination:=[A1]

sFile = Dir()

Loop

'END SECTION 3 ###

'

Application.DisplayAlerts = True

Application.ScreenUpdating = True

End Sub

***'***XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX

To whom it may concern...(2)

Convert Activesheet to XML file

expected result: on desktop ****

vba macro

Sub Convert_EXCEL_to_XML()

'Mar 14, 2016

Const sPath$ = "C:\Users\Username\Desktop" '<< expected result, xml file on desktop

Const sExt$ = ".xml"

Dim ws As Worksheet

Set ws = ActiveSheet '<< data in active sheet

Dim sName

sName = "new_XML" '<< filename

Dim r As Long, c As Long, i As Long, j As Long

r = ws.[A1].CurrentRegion.Rows.Count

c = ws.[A1].CurrentRegion.Columns.Count

Dim sFile As String

sFile = sPath & sName & sExt

Dim sData As String

Application.Calculation = xlCalculationManual

Dim obj As Object

Set obj = CreateObject("ADODB.Stream")

obj.Type = 2

obj.Charset = "UTF-8"

obj.Open

sData = "<?xml version=""1.0"" encoding=""UTF-8"" standalone=""yes""?>"

obj.WriteText sData, 1

sData = "<" & sName & " xmlns:xsi=""http://www.w3.org/2001/XMLSchema-instance"">"

obj.WriteText sData, 1

For i = 2 To r

sData = "<row>"

obj.WriteText sData, 1

For j = 1 To c

sData = "<" & ws.Cells(1, j).Value & ">" & ws.Cells(i, j).Text & "</" & ws.Cells(1, j).Value & ">"

obj.WriteText sData, 1

Next

sData = "</row>"

obj.WriteText sData, 1

Next

sData = "</" & sName & ">"

obj.WriteText sData

obj.SaveToFile sFile, 2

obj.Close

Set obj = Nothing

Application.Calculation = xlCalculationAutomatic

End Sub

XXXXXXXXXXXXXXXXX

SAMPLE

pic1

data in activesheet


pic2

open xml via i.explorer


pic3

import xml file in a new sheet