Automation of reading data from multiple XML files

Question

I've been trying to improve my code for a while now, but I can't get any further on my own.

I have a function that is executed via button press. As it is, it only works with one file.

In the best case I could click a folder and the function would loop through the subfolders and read all XML files from all subfolders and would then enter the desired words in a table.

It would help me if I could read multiple XML files from a subfolder and not just one. Maybe then I can get further and get the other part right by myself.

This is my code so far:

Private Sub CommandButtonImport_Click()
    Dim fd As Office.FileDialog                     
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    With fd
        .Filters.Clear
        .Title = "Select a XML File"
        .AllowMultiSelect = True             
            
        If .Show = True Then
            xmlFileName = .SelectedItems(1)

            Dim xDoc As Object
            Set xDoc = CreateObject("MSXML2.DOMDocument")
            xDoc.async = False: xDoc.ValidateOnParse = False
            xDoc.Load (xmlFileName)

            Set Products = xDoc.DocumentElement
            row_number = 1
            
            Rows("11:11").Select
            Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromRightOrBelow
            
            For Each Product In Products.ChildNodes
                Range("C11").Value = Products.ChildNodes(0).ChildNodes(0).Attributes.Item(21).Value
                Range("F11").Value = Products.ChildNodes(0).ChildNodes(0).Attributes.Item(0).Value
                Range("G11").Value = Products.ChildNodes(0).ChildNodes(0).ChildNodes(1).ChildNodes(0).Attributes.Item(1).Value
                Range("C:C").Columns.AutoFit 
    
                row_number = row_number + 1
            Next Product            
        End If
    End With
    
    Add_Row_Number
End Sub

I am not sure but this might Help

Any input can help and I would be very grateful thanks in advance RomanWASD

Are the files in the folder and the subfolder ? are there subfolders in the subfolders and so on ? — CDP1802
– CDP1802, Commented Jan 25, 2022 at 14:32

CDP1802 · Accepted Answer · 2022-01-25 16:52:02Z

Use the getFolder method of a FileSystemObject to create a folder object. Then use Subfolders property and Files property in a recursive manner.

Option Explicit

Private Sub CommandButtonImport_Click()
    
    Dim fd As Office.FileDialog, folder As String, n As Long
    Set fd = Application.FileDialog(msoFileDialogFolderPicker)
    With fd
        .Filters.Clear
        .Title = "Select a Folder"
        .AllowMultiSelect = True
            
        If .Show = True Then
            folder = .SelectedItems(1)
        Else
            Exit Sub
        End If
    End With
    
    Dim fso As Object, ws As Worksheet, t0 As Single: t0 = Timer
    Set ws = ActiveSheet ' or better as Thisworkbook.Sheets("Name")
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    ' recurse down folder tree
    n = n + ScanFolder(ws, fso.GetFolder(folder))
    ws.Range("C:C").Columns.AutoFit
    MsgBox n & " files scanned", vbInformation, Format(Timer - t0, "0.0 secs")
    
End Sub

Function ScanFolder(ws As Worksheet, folder As Object) As Long
    
    Dim subfolder As Object, file As Object, n As Long
    For Each subfolder In folder.SubFolders
        n = n + ScanFolder(ws, subfolder) ' recurse
    Next
   
    For Each file In folder.Files
        If file.Type = "XML Document" Then
            ParseFile ws, file
            n = n + 1
        End If
    Next
    ScanFolder = n ' number of files
    
End Function

Function ParseFile(ws As Worksheet, file As Object)

    Dim xDoc As Object, Products As Object
    Set xDoc = CreateObject("MSXML2.DOMDocument")
    
    With xDoc
        .async = False
        .ValidateOnParse = False
        .Load file.Path 'folder and filename
        Set Products = .DocumentElement
    End With
    
    If Products Is Nothing Then
    Else
        ws.Rows("11:11").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromRightOrBelow
        With Products.ChildNodes(0).ChildNodes(0)
            ws.Range("C11").Value = .Attributes(21).NodeValue
            ws.Range("F11").Value = .Attributes(0).NodeValue
            ws.Range("G11").Value = .ChildNodes(1).ChildNodes(0).Attributes(1).NodeValue
        End With
    End If

End Function

Hello, @CDP1802 Thank you very much for this solution to my problem, this is exactly what I wanted and also perfectly adapted to my code. Thank you very much for the help with my code. The solution using the "recurse down folder tree" "function" is realy fancy

LukasJin · Accepted Answer · 2022-01-25 21:18:30Z

0

I was recently dealing with a similar problem. The fastest solution I tried was to use import XML in VBA, import it as table and load table into array.

Sub xmlintoarray()
Dim FSO As Object
Dim FSOfile As Object
Dim wb As Workbook
Dim path As String

path = "C:\Documents\Studypool"
Set FSO = CreateObject("Scripting.FileSystemObject")
Set FSOfile = FSO.GetFolder(path)
Set FSOfile = FSOfile.Files
Set wb = ThisWorkbook
For Each FSOfile In FSOfile

wb.Sheets.Add.Name = FSOfile.Name

wb.XmlImport FSOfile.path, Importmap:=Nothing, overwrite:=True, _
Destination:=ThisWorkbook.Sheets(FSOfile.Name).Range("$A$1")

Next

'here insert code to merge tables
'create array from merged table
'or create merge arrays together.

End Sub

answered Jan 25, 2022 at 21:18

LukasJin

1

1 Comment

RomanWASD Over a year ago

Hello, @Lukasjin Thank you for the input, I have decided to use the other suggested solution, but I am still very grateful for the suggestion.

Collectives™ on Stack Overflow

Automation of reading data from multiple XML files

2 Answers 2

1 Comment

1 Comment

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

2 Answers 2

1 Comment

1 Comment

Your Answer

Sign up or log in

Post as a guest

Related