How to import multiple xml file into excel

[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


Thank you for your reply,

I am trying to relate this solution to one of my scenario where I was facing challenge in converting multiple xml from xl to xl.

If you could help in identifying the solution, it would be great help.

Thanks in Advance.

Regards,

Vivek.