Loop through presentations in current directory using Excel VBA

Question

The below code extracts data from the active PowerPoint presentation.

Sub ExportMultiplePowerPointSlidesToExcel()

'Declare our Variables
Dim ppApp As PowerPoint.Application
Dim PPTPres As PowerPoint.Presentation
Dim PPTSlide As PowerPoint.Slide
Dim PPTShape As PowerPoint.Shape
Dim PPTTable As PowerPoint.Table
Dim PPTPlaceHolder As PowerPoint.PlaceholderFormat

'Declare Excel Variables.
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlWrkSheet As Excel.Worksheet
Dim xlRange As Excel.Range

'Grab the Currrent Presentation.
Set ppApp = GetObject(, "PowerPoint.Application")
Set PPTPres = ppApp.ActivePresentation
Set PPTSlide = PPTPres.Slides(1)
                     
'Grab the Currrent Presentation.
                     
    'Keep going if there is an error
    On Error Resume Next
    
    'Get the Active instance of Outlook if there is one
    Set xlApp = GetObject(, "Excel.Application")
    
    'If Outlook isn't open then create a new instance of Outlook
    If Err.Number = 429 Then
        
        'Clear Error
        Err.Clear
        
        'Create a new Excel App.
        Set xlApp = New Excel.Application
            
        'Make sure it's visible.
        xlApp.Visible = True
            
        'Add a new workbook.
        Set xlBook = xlApp.Workbooks.Add
            
        'Add a new worksheet.
        Set xlWrkSheet = xlBook.Worksheets.Add
    
    End If
    
    'Set the Workbook to the Active one, if Excel is already open. THIS ASSUMES WE HAVE A WORKBOOK IN THE EXCEL APP.
    Set xlBook = Workbooks("Cycle 2 - FSO Dirs and EDs - CCG  Talent Review template.xlsm")
    
    'Set the Worksheet to the Active one, if Excel is already open. THIS ASSUMES WE HAVE A WORKSHEET IN THE WORKBOOK.
    Set xlWrkSheet = xlBook.Worksheets("CCG list")
    
    Range("B3").Value = PPTSlide.Shapes(4).TextFrame.TextRange
    Range("E3").Value = PPTSlide.Shapes(7).TextFrame.TextRange
    
    'Set the Worksheet Column Width.
    xlWrkSheet.Columns.ColumnWidth = 20
    
    'Set the Worksheet Row Height.
    xlWrkSheet.Rows.RowHeight = 20
    
    'Set the Horizontal Alignment so it's to the Left.
    xlWrkSheet.Cells.HorizontalAlignment = xlLeft
    
    'Turn off the Gridlines.
    xlApp.ActiveWindow.DisplayGridlines = False
    
End Sub

How do I loop through the presentations in the current directory to perform the action?

I have attempted numerous methods but I can't seem to indicate each presentation. The name of the presentation should be irrelevant.