VBA to import XML files from multiple subfolders of a folder and save imported data to XLSM files by folder

[Imposter]

Hello,

Spoiler

On the very last step of my project I faced a problem with my computer limitation to process data and Excel engine limitation of 1'048'576 rows. I'm here looking for help. I'm not quite familiar with VBA and quite exosted with this project (I'm helping my local organization supporting homeless people & veterans to get government support and I'm doing it all for free). I'd be really grateful if somebody could support me finishing this.

I need to import thousands of XML files with unique filenames (from multiple level one subfolders inside main folder, i.e. xmlDownload\0001\*.xml) to template XLSM file (with customized XML Map/Scheme), apply data transformation using Power Query inside this XLSM file (using query refresh) and save transformed result sheet as a separate XLSM file for each folder (i.e. xmlDownload\0001.xlsm).

The steps required are:
1) open XLSM template file and run VBA Macro
2) folder selection dialig appears > you select folder (i.e. xmlDownload) with folders, each folder contains XML files (i.e. xmlDownload\0001\*.xml)
3) each folder's XML files are imported to "XML" sheet of template, then query on "Data" sheet is refreshed and Power Query transformations get applied to data and pasted to "Data" sheet, then "Data" sheet is copied to new workbook with name "0001.xslm" and saved in same folder as XLSM template.

Spoiler

At first I planned placing all files into one folder and importing from there, but it turned out a) my computer don't have enough RAM (inc. virtual memory because of insufficient disk space) to apply transformations to so much data at once; b) it takes forever; c) I can easily exceed Excel Engine limitation on rows while doing all at once. Thus I made a batch file that separates all my XML files into folders by 10000 files, i.e. xmlDownload\0001\*.xml, xmlDownload\0002\*.xml, etc.

Here's the code I 've got that does the following for single folder containing any number of XML files:
1) XLSM template file contains ready-made (customized) XML Map on sheet "XML" and Power Query on sheet "Data"
2) Run Macro > folder selecting dialog appears > you select folder with XML files
3) XML data is imported to "XML" sheet
4) query on "Data" sheet is refreshed and Power Query transformations get applied to data

Sub Import_all_XML_files_from_the_specified_folder_preserving_existing_XML_Map()
' https://www.extendoffice.com/documents/excel/3388
Application.DisplayAlerts = False
    Dim xWb As Workbook
    Dim xSWb As Workbook
    Dim xStrPath As String
    Dim xFileDialog As FileDialog
    Dim xFile As String
    Dim xCount As Long
    Dim xURL As String
    Dim n As Long
    Set xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
    xFileDialog.AllowMultiSelect = False
    xFileDialog.Title = "Select a folder"
    If xFileDialog.Show = -1 Then
        xStrPath = xFileDialog.SelectedItems(1)
    End If
    If xStrPath = "" Then Exit Sub
    Application.ScreenUpdating = False
    Set xSWb = ThisWorkbook
    xFile = Dir(xStrPath & "\*.xml")
    Do While xFile <> ""
            xURL = xStrPath & "\" & xFile
            xmlImport xURL, xSWb
        xFile = Dir()
    Loop
'    xSWb.Save
    Application.ScreenUpdating = True
    Exit Sub
Application.DisplayAlerts = True
End Sub
Sub xmlImport(xURL As String, Wb As Workbook)
Application.DisplayAlerts = False
    Dim xMap As XmlMap
    Set xMap = Wb.XmlMaps(1)
        xMap.Import URL:=xURL, Overwrite:=False
    Sheets("Data").Select
    Selection.ListObject.QueryTable.Refresh BackgroundQuery:=False
Application.DisplayAlerts = True
End Sub

That's as far as I could bet by myself.

Spoiler

Here's BAT code to separate mamy XML files into folders (xmlStack-001, etc.) by 100 file in case someone needs it:

cd /d "%~dp0\xmlDownload"
:: https://stackoverflow.com/a/2542286
set groupsize=100
set n=1
set nf=0
for %%f in (*.xml) do (
  if !n!==1 (
    set /a nf+=1
    md xmlStack-!nf!
  )
  move /Y "%%f" xmlStack-!nf!
  if !n!==!groupsize! (
    set n=1
  ) else (
    set /a n+=1
  )
)
pause

And here're my files (my XLSM template and several XML files to play with) - link.

Kind regards,

Imposter

 

[Imposter]

I posted on different forum literally 5 minutes ago and didn't have time to provide any link here. Thank you for helping out by providing link to my very own post describing the issue, I guess .

Cross-posting (posting the same question in more than one forum) is not against our rules, but the method of doing so is covered by #13 of the Forum Rules.

Be sure to follow & read the link at the end of the rule too!

Cross posted at: Import XML files from each subfolder to separate XLS for each subfolder as save
If you have posted the question at more places, please provide links to those as well.

If you do cross-post in the future and also provide links, then there shouldn’t be a problem.

 

[Fluff]

I posted on different forum literally 5 minutes ago and didn't have time to provide any link here.

That doesn't explain why you didn't supply a link there, which makes me suspect you weren't going to post one here either.

 

[Imposter]

That doesn't explain why you didn't supply a link there, which makes me suspect you weren't going to post one here either.

Well what's a reasonable explanation that counts ? I'm a human being, not a robot. Need extra 5 min once in a while to write post, you know.

 

[Imposter]

Tried using Subfolders.Path - no luck, no XML files are imported from subfolders ?:

Sub Test()
    Dim oFSO As Object
    Dim Folder As Object
    Dim Subfolders As Object
    Dim xWb As Workbook
    Dim xSWb As Workbook
    Dim xFile As String
    Dim xMap As XmlMap
    Dim xURL As String
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    Set Folder = oFSO.GetFolder(ThisWorkbook.Path & "\xmlDownload")
    Set Subfolder = Folder.Subfolders
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    For Each Subfolder In Folder.Subfolders
        xFile = Dir("\*.xml")
        Do While xFile <> ""
            Set xMap = ThisWorkbook.XmlMaps(1)
            xURL = Subfolder.Path & "\" & xFile
            xMap.Import URL:=xURL, Overwrite:=False
            Sheets("Data").Select
            Selection.ListObject.QueryTable.Refresh BackgroundQuery:=False
        xFile = Dir()
    Loop
    Call Save_file_with_sequential_name
    Call Cleanup_sheets_before_next_import
    Exit Sub
    Next Subfolder
    Application.ScreenUpdating = True
    Set oFSO = Nothing
    Set Folder = Nothing
    Set Subfolders = Nothing
End Sub
   
Public Sub Save_file_with_sequential_name()
    Dim fileName As String
    fileName = GetNextFileName(ActiveWorkbook.Path & "\Folder_|n|.xlsm")
    MsgBox "Next file name is " & fileName
    ActiveWorkbook.SaveCopyAs fileName
End Sub
Public Function GetNextFileName(filePath As String) As String
    Dim n As Integer
    n = 0
    Do
        n = n + 1
        GetNextFileName = Replace(filePath, "|n|", n)
    Loop Until Dir(GetNextFileName) = vbNullString
End Function

Sub Cleanup_sheets_before_next_import()
With Sheets("XML")
    .Rows(2 & ":" & .Rows.Count).Delete
End With
With Sheets("Data")
    .Rows(2 & ":" & .Rows.Count).Delete
End With
End Sub

 

[Imposter]

I tried to simplify the code to only specific task that it fails to do to isolate the problem: importing *.xml files from level one subfolders of parent folder, i.e. <institionInfo.xlsm_template_location>\xmlDownload\0001\*.xml, <institionInfo.xlsm_template_location>\xmlDownload\0002\*.xml, etc. I believe this code should do the following:
1) import *.xml files from subfolder xmlDownload\0001
2) refresh query sheet
3) save a copy whole file as <institionInfo.xlsm_template_location>\Folder_1.xls
4) import *.xml files from subfolder xmlDownload\0002 and append that to the bottom row of previous 0001 imported folder
5) refresh query sheet
6) save a copy whole file as <institionInfo.xlsm_template_location>\Folder_2.xls
7) loop for other subfolders, i.e. 0003.

My current VBA code just skips importing alltogether (like there're no *.xml files at all), going straight to saving file just one time, but it should at least do it 3 times (for every subfolder insude xmlDownload\):

Sub Test()
    Dim oFSO As Object
    Dim Folder As Object
    Dim Subfolders As Object
    Dim xWb As Workbook
    Dim xSWb As Workbook
    Dim xFile As String
    Dim xMap As XmlMap
    Dim xURL As String
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    Set Folder = oFSO.GetFolder(ThisWorkbook.Path & "\xmlDownload")
    Set Subfolder = Folder.Subfolders
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    For Each Subfolder In Folder.Subfolders
        xFile = Dir("\*.xml")
        Do While xFile <> ""
            Set xMap = ThisWorkbook.XmlMaps(1)
            xURL = Subfolder.Path & "\" & xFile
            xMap.Import URL:=xURL, Overwrite:=False
            Sheets("Data").Select
            Selection.ListObject.QueryTable.Refresh BackgroundQuery:=False
        xFile = Dir()
    Loop
    Call Save_file_with_sequential_name
    Exit Sub
    Next Subfolder
    Application.ScreenUpdating = True
    Set oFSO = Nothing
    Set Folder = Nothing
    Set Subfolders = Nothing
End Sub
   
Public Sub Save_file_with_sequential_name()
    Dim fileName As String
    fileName = GetNextFileName(ActiveWorkbook.Path & "\Folder_|n|.xls")
    MsgBox "Next file name is " & fileName
    ActiveWorkbook.SaveCopyAs fileName
End Sub
Public Function GetNextFileName(filePath As String) As String
    Dim n As Integer
    n = 0
    Do
        n = n + 1
        GetNextFileName = Replace(filePath, "|n|", n)
    Loop Until Dir(GetNextFileName) = vbNullString
End Function

I have provided example files in my first post to download, however since they may have excessive data, I'm attaching stripped down version to illustrate the issue to this post. Files in archive are folder structure and institutionInfo.xlsm template file containing 2 Macro:
1) A_Import_XML_from_subfolders_that_fails (code from this post)
2) B_Import_XML_from_subfolders_with_folder_picker_that_works (simplified code from first post)

Oh, looks like forum is too advanced to accept ZIP attachment. Well, I've attached the archive to the first post on different forum (apparently one needs 2-3 forums to ask Excel-related question, I guess), here's the link.

 

[Imposter]

OK, I figured out everything on my own. VBA code with description and example files can be found on different forum, link can be found on the first page of this discussion.