Microsoft Excel: List all files and properties of a specific criteria in a particular directory inside a worksheet called "Files"

ListFilesInDirectory.bas

'ListFilesInDirectory
'Lists all files of specific criteria (e.g., '*.pdf') in certain folder
Sub ListFilesInDirectory()

  On Error GoTo ErrHandler

  Dim sFilename As String, sPath As String
  Dim fsFile, fsFileProps As Object
  Dim sProceed As Integer
  Dim i As Long
    
  'Prompt user to ensure they are OK with clearing the sheet and replacing with new data
  sProceed = MsgBox("Do you want to clear the sheet and run the file listing again?", vbYesNo)
  
  If (sProceed <> 6) Then
    Call ProcessFinish
    Exit Sub
  End If
  
  'Clear worksheet
  ThisWorkbook.Worksheets("Files").Select
  ThisWorkbook.Worksheets("Files").Cells.Clear
    
  'Set Headings
  ThisWorkbook.Worksheets("Files").Range("A1").Value = "Filename"
  ThisWorkbook.Worksheets("Files").Range("B1").Value = "Filepath"
  ThisWorkbook.Worksheets("Files").Range("C1").Value = "Doc Type"
  ThisWorkbook.Worksheets("Files").Range("D1").Value = "Date Created"
  ThisWorkbook.Worksheets("Files").Range("E1").Value = "Date Modified"
  ThisWorkbook.Worksheets("Files").Range("F1").Value = "Filesize (KB)"
  
  'Set file attributes, path from "Controls" worksheet
  sPath = ThisWorkbook.Worksheets("Controls").Cells(2, 2).Value
  If Not (Right(sPath, 1) = "\") Then sPath = sPath & "\" 'Adds trailing slash of non-existent
  sFilename = "*" 'all filenames are considered, "*.doc" to get only .docs
  
  'Set the properties object to get information about the file
  Set fsFileProps = CreateObject("Scripting.FileSystemObject")
    
  'Checks if directory empty
  If Dir(sPath, vbDirectory) <> "" Then
    
    fsFile = Dir(sPath & sFilename)
      
    'Start counter
    i = 2
  
    'Iterates through each file in the directory
    Do While fsFile <> ""
            
      'Insert doc data into appropriate columns
      ThisWorkbook.Worksheets("Files").Cells(i, 1).Value = fsFile                                                             'Col A - Filename
      ThisWorkbook.Worksheets("Files").Cells(i, 2).Value = sPath & fsFile                                                     'Col B - Filepath
      ThisWorkbook.Worksheets("Files").Cells(i, 3).Value = Right(filenameSplit(5), 3)                                         'Col C - Filetype
      ThisWorkbook.Worksheets("Files").Cells(i, 4).Value = fsFileProps.GetFile(sPath & (CStr(fsFile))).DateCreated            'Col D - Date Created
      ThisWorkbook.Worksheets("Files").Cells(i, 5).Value = fsFileProps.GetFile(sPath & (CStr(fsFile))).DateLastModified       'Col E - Date Modified
      ThisWorkbook.Worksheets("Files").Cells(i, 6).Value = (fsFileProps.GetFile(sPath & (CStr(fsFile))).Size / 1024)          'Col F - Filesize (KB)
  
      i = i + 1
      fsFile = Dir
            
    Loop
      
    'Whilst directory wasn't empty, this determines if files matching criteria were found or not
    If (i = 2) Then
        MsgBox "No files like " & sFilename & " found"
    End If
    
  Else
  
      'No files found, display message
      MsgBox "No files Found"
    
  End If

  'Clean up worksheet with correct formats
  ThisWorkbook.Worksheets("Files").Range("C:C").NumberFormat = "00000"
  ThisWorkbook.Worksheets("Files").Range("L:L").NumberFormat = "#######.00"

  'Clear memory
  Set fsFile = Nothing
  Set fsFileProps = Nothing
  
  MsgBox ("Complete")
  
End Sub