Automation of reading data from multiple XML files

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

Solution

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