How to import multiple xml file into excel

yes i had to reinstall office after my laptop suffered a virus attack.

the macro worked well. i found some issue in the data format. i corrected it manually...

Thanks you so much for your help!!! surathsarkar

JIMZCE,

I have added some line in macro for you. I am not sure how you want your data to be, but as per standard format I have added some lines.

In case you have some different requirement you could let me know with some example and I will help you to automate the whole process.

Example of xml data :

<name>Ebcd</name>

<address>Indiana</address>

<phoneno>111-111-1110</phoneno>

<name>Efgh</name>

<address>Kansas</address>

<phoneno>989-999-9990</phoneno>

Example of data after execution of macro:

Name	Address	Phone no
Ebcd	Indiana	111-111-1110
Efgh	Kansas	989-999-9990
Mnop	Utah	777-777-7770

Note: Add "Name" where "********"

It should be in the quot Ex : "Name"

So that it will filter with "Name" heading. if your heading name is "ID" then add "ID" if "lastModified"

add "lastModified".

don't worry it just for formatting after execution it will give you complete data then you can apply your own filters.

I hope this will help you.

• I just wanted to suggest you test this macro in a test file, before use it in production.

---

Option Explicit

Sub GetLmsDtata()

On Error Resume Next

Dim xRow As Long

Dim path As String

Dim strSheetName As String

Dim xDirect$, xFname$, InitialFoldr$

InitialFoldr$ = "C:\Users%username%"

With Application.FileDialog(msoFileDialogFolderPicker)

.InitialFileName = Application.DefaultFilePath & ""

.Title = "Please select a folder contains xml Files"

.InitialFileName = InitialFoldr$

.Show

If .SelectedItems.Count <> 0 Then

xDirect$ = .SelectedItems(1) & ""

xFname$ = Dir(xDirect$ & "*.xml")

Do While xFname$ <> ""

path = (xDirect$ & xFname$)

ActiveWorkbook.XmlImport URL:= _

      path, _

     ImportMap:=Nothing, Overwrite:=True, Destination:=ActiveCell

     Selection.End(xlDown).Offset(1, 0).Select

xFname$ = Dir()

Loop

End If

End With

Application.ScreenUpdating = False

ActiveSheet.UsedRange.Select

Selection.Copy

Worksheets(2).Activate

ActiveSheet.Range("A1").Select

Selection.PasteSpecial Paste:=xlValues, _

Operation:=xlNone, SkipBlanks:=False, _

Transpose:=False

Worksheets(2).Activate

ActiveSheet.Range("A1").Select

ActiveSheet.Range(Selection, Selection.End(xlToRight)).Select

Selection.Copy Destination:=Sheet3.Range("A1")

ActiveSheet.UsedRange.Select

Selection.AutoFilter

    ActiveSheet.UsedRange.AutoFilter Field:=1, Criteria1:= _

        "**********"

      ActiveSheet.UsedRange.Select

      Selection.Delete Shift:=xlUp

      Selection.Copy Destination:=Sheet3.Range("A2")

      Worksheets(3).Activate

      ActiveSheet.Range("A1").Select

      ActiveSheet.Range(Selection, Selection.End(xlToRight)).Select

    Selection.Font.Bold = True

    With Selection.Interior

        .Pattern = xlSolid

        .PatternColorIndex = xlAutomatic

        .ThemeColor = xlThemeColorAccent1

        .TintAndShade = -0.249977111117893

        .PatternTintAndShade = 0

    End With

    With Selection.Font

        .ThemeColor = xlThemeColorDark1

        .TintAndShade = 0

    End With

    Worksheets(2).Activate

    Cells.Select

    Selection.Delete Shift:=xlUp

    Worksheets(1).Activate

    Cells.Select

    Selection.Delete Shift:=xlUp

    Worksheets(3).Activate

    ActiveSheet.UsedRange.Copy Destination:=Sheet1.Range("A1")

    ActiveSheet.Cells.Select

    Selection.Delete Shift:=xlUp

    Worksheets(1).Activate

        Cells.Select

    Selection.ColumnWidth = 10.14

    Selection.ColumnWidth = 13.29

    Application.ScreenUpdating = True

    ActiveSheet.Range("A1").Select

    MsgBox ("Completed")

End Sub

---

HI there.

When I use the original code posted all XML files import fine, but when I use any of the updated codes to remove headers (and sorting issues) I get the"No XML" error and only one XML file imports. why might this be?

thank you