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]

It looks like I've found a part of solution (in different thread), but still failing to execute it. This VBA returns file names inside all subfolders of "<template_XLSM_location>\xmlDownload" folder to "Files" sheet of template file.

Sub List_all_files_in_subfolders()
    'https://www.mrexcel.com/board/threads/1172585/page-2#post-5701274
    Dim oFSO As Object
    Dim folder As Object
    Dim subfolders As Object
    Dim xFile As Object
    Dim Wks As Worksheet
    Dim rowIndex As Long
    Dim Col As Integer
    Col = 1
    rowIndex = 2
    Set Wks = ThisWorkbook.Sheets("Files")                '==>> TO ADAPT
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    Set folder = oFSO.GetFolder(ThisWorkbook.Path & "\xmlDownload")    '==>> TO ADAPT
    Set subfolders = folder.subfolders
    Application.ScreenUpdating = False
    Wks.UsedRange.ClearContents
    For Each subfolders In folder.subfolders
        With Wks.Cells(1, Col)
            .Value = subfolders.Name
            .Hyperlinks.Add Anchor:=Wks.Cells(1, Col), Address:=subfolders
            .Font.Color = vbBlack
            .Font.Underline = xlUnderlineStyleNone
        End With
        For Each xFile In subfolders.Files
            With Application.ActiveSheet.Cells(rowIndex, Col)
                .Formula = xFile.Name
                .Hyperlinks.Add Anchor:=Cells(rowIndex, Col), Address:=subfolders & "\" & xFile.Name
                .Font.Color = vbBlack
                .Font.Underline = xlUnderlineStyleNone
            End With
            rowIndex = rowIndex + 1
        Next xFile
        Col = Col + 1
        rowIndex = 2
    Next subfolders
    Wks.Columns.AutoFit
    Application.ScreenUpdating = True
    Set oFSO = Nothing
    Set folder = Nothing
    Set subfolders = Nothing
End Sub

It looks like I need to replace this section with the code from first message, I just struggle to implement this with saving a new file:

For Each subfolders In folder.subfolders
'My XML files processing code

I can totally live without folder selecting dialog and saving XLSM file to "xmlDownload\0001\0001.xlsm" will do it too (I'll just use BAT to fix this later).

 

[Imposter]

I also found VBA to save new file with sequential naming:

Public Sub Save_file_with_sequential_name()
' https://www.mrexcel.com/board/threads/1051681/post-5049685
    Dim fileName As String
    fileName = GetNextFileName(ActiveWorkbook.Path & "\Folder_|n|.xlsm")
    MsgBox "Next file name is " & fileName
    ActiveWorkbook.SaveCopyAs fileName  'or SaveAs
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

Now I just need to combine everything together somehow for each subfolder. This works, but only for one (selected) folder:

Sub Import_all_XML_files_from_the_specified_folder_preserving_existing_XML_Map()
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
    Call Save_file_with_sequential_name
    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

Public Sub Save_file_with_sequential_name()
' https://www.mrexcel.com/board/threads/1051681/
    Dim fileName As String
    fileName = GetNextFileName(ActiveWorkbook.Path & "\Folder_|n|.xlsm")
    MsgBox "Next file name is " & fileName
    ActiveWorkbook.SaveCopyAs fileName  'or SaveAs
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

 

[Imposter]

This "Test" Macro calling other mentioned here partially works but it keeps asking to select the next folder and even if I will remove folder selection this VBA will keep adding data to the save template file and saving it to a new file after each XML is imported. I fee like I'm close but I'd really use some help here...

Sub Test()
    'https://www.mrexcel.com/board/threads/1172585/
    Dim oFSO As Object
    Dim folder As Object
    Dim subfolders As Object
    Dim xFile As Object
    Dim Wks As Worksheet
    Dim rowIndex As Long
    Dim Col As Integer
    Col = 1
    rowIndex = 2
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    Set folder = oFSO.GetFolder(ThisWorkbook.Path & "\xmlDownload")
    Set subfolders = folder.subfolders
    Application.ScreenUpdating = False
    For Each subfolders In folder.subfolders
        Call Import_all_XML_files_from_the_specified_folder_preserving_existing_XML_Map
    Next subfolders
    Application.ScreenUpdating = True
    Set oFSO = Nothing
    Set folder = Nothing
    Set subfolders = Nothing
End Sub

Sub Import_all_XML_files_from_the_specified_folder_preserving_existing_XML_Map()
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
    Call Save_file_with_sequential_name
    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

Public Sub Save_file_with_sequential_name()
' https://www.mrexcel.com/board/threads/1051681/
    Dim fileName As String
    fileName = GetNextFileName(ActiveWorkbook.Path & "\Folder_|n|.xlsm")
    MsgBox "Next file name is " & fileName
    ActiveWorkbook.SaveCopyAs fileName  'or SaveAs
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

 

[Imposter]

OK, I added Macro on top Macro to cleanup previously imported data before next XML folder is processed, it's working, main Macro to run is "Test":

Sub Test()
    'https://www.mrexcel.com/board/threads/1172585/
    Dim oFSO As Object
    Dim folder As Object
    Dim subfolders As Object
    Dim xFile As Object
    Dim Wks As Worksheet
    Dim rowIndex As Long
    Dim Col As Integer
    Col = 1
    rowIndex = 2
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    Set folder = oFSO.GetFolder(ThisWorkbook.Path & "\xmlDownload")
    Set subfolders = folder.subfolders
    Application.ScreenUpdating = False
    For Each subfolders In folder.subfolders
        Call Import_all_XML_files_from_the_specified_folder_preserving_existing_XML_Map
    Next subfolders
    Application.ScreenUpdating = True
    Set oFSO = Nothing
    Set folder = Nothing
    Set subfolders = Nothing
End Sub

Sub Import_all_XML_files_from_the_specified_folder_preserving_existing_XML_Map()
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
    Call Save_file_with_sequential_name
    Call Cleanup_sheets_before_next_import
    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

Public Sub Save_file_with_sequential_name()
' https://www.mrexcel.com/board/threads/1051681/
    Dim fileName As String
    fileName = GetNextFileName(ActiveWorkbook.Path & "\Folder_|n|.xlsm")
    MsgBox "Next file name is " & fileName
    ActiveWorkbook.SaveCopyAs fileName  'or SaveAs
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

Now I just need to figure out how to select folder just one time or just not select at all and set it to something like ActiveWorkbook.Path & "\xmlDownload". Any help?

 

[Imposter]

I mean set main (parent) folder that includes my subfolders only once.

 

[Imposter]

Well I can't figure out why this is not working. I'm trying to point Import_all_XML_files_from_subfolder_preserving_existing_XML_Map() to use subfolder data. But it seems it can't find any XML files when running inside subfolders of Test() Macro. The code above (post #5) is good but I'd like to skip selecting every folder, I need Macro to just run on subfolders 0001, 0002, 0003, etc. inside ActiveWorkbook.Path & "\xmlDownload" parent folder. What am I doing wrong?

Sub Test()
    'https://www.mrexcel.com/board/threads/1172585/
    Dim oFSO As Object
    Dim Folder As Object
    Dim Subfolders As Object
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    Set Folder = oFSO.GetFolder(ThisWorkbook.Path & "\xmlDownload")
    Set Subfolders = Folder.Subfolders
    Application.ScreenUpdating = False
    For Each Subfolders In Folder.Subfolders
        Call Import_all_XML_files_from_subfolder_preserving_existing_XML_Map
    Next Subfolders
    Application.ScreenUpdating = True
    Set oFSO = Nothing
    Set Folder = Nothing
    Set Subfolders = Nothing
End Sub

Sub Import_all_XML_files_from_subfolder_preserving_existing_XML_Map()
Application.DisplayAlerts = False
    Dim xWb As Workbook
    Dim xSWb As Workbook
    Dim xFile As String
    Dim xURL As String
    Dim n As Long
    Application.ScreenUpdating = False
    Set xSWb = ThisWorkbook
    xFile = Dir("\*.xml")
    Do While xFile <> ""
            xURL = "\" & xFile
            xmlImport xURL, xSWb
        xFile = Dir()
    Loop
    Call Save_file_with_sequential_name
    Call Cleanup_sheets_before_next_import
    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

Public Sub Save_file_with_sequential_name()
' https://www.mrexcel.com/board/threads/1051681/
    Dim fileName As String
    fileName = GetNextFileName(ActiveWorkbook.Path & "\Folder_|n|.xlsm")
    MsgBox "Next file name is " & fileName
    ActiveWorkbook.SaveCopyAs fileName  'or SaveAs
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

On a side note, this code for importing XML works for single hardcoded folder:

Sub Import_all_XML_files_from_xPath_folder_preserving_existing_XML_Map()
Application.DisplayAlerts = False
    'Dim xWb As Workbook
    Dim xSWb As Workbook
    Dim xPath As String
    Dim xFile As String
    Dim xURL As String
    Dim n As Long
    Application.ScreenUpdating = False
    Set xSWb = ThisWorkbook
    xPath = "C:\Users\User\Downloads\xmlVBAinstitutionInfo\xmlDownload\0001"
    ChDir xPath
    xFile = Dir("*.xml")
    'xFile = Dir(ThisWorkbook.Path & "\xmlDownload\0001\*.xml")
    Do While xFile <> ""
            xURL = xFile
            xmlImport xURL, xSWb
        xFile = Dir()
    Loop
    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

Some help finishing this would be very useful!

 

[Imposter]

It looks like it cannot find correct path of *.xml to import when working inside subfolder. How do I solve this? I've merged Test() and Import_XML...() Macros but it didn't help, same result as above.

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 xURL As String
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    Set Folder = oFSO.GetFolder(ThisWorkbook.Path & "\xmlDownload")
    Set Subfolders = Folder.Subfolders
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    For Each Subfolders In Folder.Subfolders
        Set xSWb = ThisWorkbook
        xFile = Dir("\*.xml")
        Do While xFile <> ""
            xURL = "\" & xFile
            xmlImport xURL, xSWb
        xFile = Dir()
    Loop
    Call Save_file_with_sequential_name
    Call Cleanup_sheets_before_next_import
    Exit Sub
    Next Subfolders
    Application.ScreenUpdating = True
    Set oFSO = Nothing
    Set Folder = Nothing
    Set Subfolders = Nothing
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
   
Public Sub Save_file_with_sequential_name()
' https://www.mrexcel.com/board/threads/1051681/
    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]

Testing subfolders for contents works, it's just path to XML files that is not working correctly...

Sub Test()
    'https://www.mrexcel.com/board/threads/1172585/
    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 xURL As String
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    Set Folder = oFSO.GetFolder(ThisWorkbook.Path & "\xmlDownload")
    Set Subfolders = Folder.Subfolders
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    For Each Subfolders In Folder.Subfolders
       If Subfolders.Name = "0001" Then
        MsgBox "OK"
       End If
    Call Save_file_with_sequential_name
    'Call Cleanup_sheets_before_next_import
    Exit Sub
    Next Subfolders
    Application.ScreenUpdating = True
    Set oFSO = Nothing
    Set Folder = Nothing
    Set Subfolders = Nothing
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
   
Public Sub Save_file_with_sequential_name()
' https://www.mrexcel.com/board/threads/1051681/
    Dim fileName As String
    fileName = GetNextFileName(ActiveWorkbook.Path & "\Folder_|n|.xlsm")
    MsgBox "Next file name is " & fileName
    ActiveWorkbook.SaveCopyAs fileName  'or SaveAs
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

 

[Fluff]

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.