Sub ListFiles()
'DECLARE AND SET VARIABLEs
Dim ShellApplication As Object
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Set ShellApplication = CreateObject("Shell.Application").BrowseForFolder(0, "Please choose a folder", 0, OpenAt)
Path = ShellApplication.self.Path
Set ShellApplication = Nothing
[a3] = "XML"
[b3] = "Files"
'DEFAULT PATH FROM HIDDEN SHEET
Call ListMyFiles(Path, True)
End Sub

Sub ListMyFiles(mySourcePath, IncludeSubfolders)
    Set MyObject = New Scripting.FileSystemObject
    Set mySource = MyObject.GetFolder(mySourcePath)
    'With SearchXML
    Application.ScreenUpdating = False

'--------------------------------------------------------------------
    'FIND XML FILES ONLY, APPLY SEARCH CRIERIA, DISPLAY MATCHES ONLY
    For Each myfile In mySource.Files
        If Right(myfile.Name, 3) = "XML" Or Right(myfile.Name, 3) = "xml" Then 'IS XML?
            LastRow = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row

   
 '-------------------------------------------------------------
            'IMPORT XML FILE
            Application.DisplayAlerts = False
            ActiveWorkbook.XmlImport URL:=mySource & "\" & myfile.Name, _
                ImportMap:=Nothing, Overwrite:=True, Destination:=Range("$B$" & LastRow + 1)
            Cells(LastRow + 1, 1) = myfile.Name

'------------------------------------------------------------
            'DELETE MAPS
            maps = ActiveWorkbook.XmlMaps.Count
            For i = 1 To maps
                ActiveWorkbook.XmlMaps(1).Delete
            Next i
        End If
    Next
    If IncludeSubfolders Then 'SEARCH SUBFOLDERS FOR SAME CRITERIA
        For Each MySubFolder In mySource.SubFolders
            Call ListMyFiles(MySubFolder.Path, True)
        Next
    End If
    'End With
    Application.ScreenUpdating = True
Application.DisplayAlerts = True
Sheets("XMLData").UsedRange.WrapText = False
End Sub

Sub ListFiles()
'DECLARE AND SET VARIABLEs
Dim ShellApplication As Object
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Set ShellApplication = CreateObject("Shell.Application").BrowseForFolder(0, "Please choose a folder", 0, OpenAt)
Path = ShellApplication.self.Path
Set ShellApplication = Nothing
[a3] = "XML"
[b3] = "Files"
'DEFAULT PATH FROM HIDDEN SHEET
Call ListMyFiles(Path, True)
End Sub

Sub ListMyFiles(mySourcePath, IncludeSubfolders)
    Set MyObject = New Scripting.FileSystemObject
    Set mySource = MyObject.GetFolder(mySourcePath)
    'With SearchXML
    Application.ScreenUpdating = False

'--------------------------------------------------------------------
    'FIND XML FILES ONLY, APPLY SEARCH CRIERIA, DISPLAY MATCHES ONLY
    For Each myfile In mySource.Files
        If Right(myfile.Name, 3) = "XML" Or Right(myfile.Name, 3) = "xml" Then 'IS XML?
            LastRow = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row

   
 '-------------------------------------------------------------
            'IMPORT XML FILE
            Application.DisplayAlerts = False
            ActiveWorkbook.XmlImport URL:=mySource & "\" & myfile.Name, _
                ImportMap:=Nothing, Overwrite:=True, Destination:=Range("$B$" & LastRow + 1)
            Cells(LastRow + 1, 1) = myfile.Name

'------------------------------------------------------------
            'DELETE MAPS
            maps = ActiveWorkbook.XmlMaps.Count
            For i = 1 To maps
                ActiveWorkbook.XmlMaps(1).Delete
            Next i
        End If
    Next
    If IncludeSubfolders Then 'SEARCH SUBFOLDERS FOR SAME CRITERIA
        For Each MySubFolder In mySource.SubFolders
            Call ListMyFiles(MySubFolder.Path, True)
        Next
    End If
    'End With
    Application.ScreenUpdating = True
Application.DisplayAlerts = True
Sheets("XMLData").UsedRange.WrapText = False
End Sub

I have adapted a VBA code to import all the XML files I have on a folder into excel. I have tried to run the code with only two files and it takes about 30 seconds. Several minutes to import less than 20 files.

I need to import more than 200,000 files. Can you please help me on how to improve my code?

My code is the following:

I have adapted a VBA code to import all the XML files I have on a folder into Excel. I have tried to run the code with only two files and it takes about 30 seconds. Several minutes to import less than 20 files.

I need to import more than 200,000 files. Can you please help me on how to improve my code?