Automation of reading data from multiple XML files - excel

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

Answer 1

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

Answer 2

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