Excel Macro: List Files in Subfolders, Version 2

This Excel macro can list files in a specified folder and subfolders, and you can filter multiple file types. The difference from the previous macro (See: Excel Macro: List All Files in Folders and Subfolders) is that you can get more file information, such as video duration/length.

List Files in Folders and Subfolders

This is a Nested-Function, you need call this function in a Sub procedure. Note that this macro only lists "MKV", "AVI", "MP4" files, you can change to yours.

Sub GetFilesInFolder(FolderPath As String, GetSubfolders As Boolean)
' For Example: GetFilesInFolder("D:\YourFolderName", True)
' Url: https://excelbaby.com/learn/excel-macro-list-files-in-subfolders-version-2/

    Dim FSO As Object, objFolder As Object
    Dim SubFolder, FileItem
    Dim LastBlankCell As Long
    
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set objFolder = FSO.GetFolder(FolderPath)
    
    Application.ScreenUpdating = False 'Disable Screen Updating to speed up macro
    
    LastBlankCell = Cells(Rows.Count, 1).End(xlUp).Row + 1 'Get the last blank cell of column A
    
    ' Table header
    If LastBlankCell = 2 Then
        Range("A1:L1").Value = Array("#", "Name", "Base Name", "Attributes", "Path", "Size", _
            "Type", "Extension", "Date Created", "Date Last Accessed", "Date Last Modified", "Length")
    End If
        
    ' Main loop
    For Each FileItem In objFolder.Files
        FileExtension = UCase(FSO.GetExtensionName(FileItem.Name)) 'Get file extension
    
        Select Case FileExtension
            Case "MKV", "AVI", "MP4"    'Get "MKV", "AVI", "MP4" files
                Cells(LastBlankCell, 1) = LastBlankCell - 1                 '#
                Cells(LastBlankCell, 2) = FileItem.Name                     'Name
                Cells(LastBlankCell, 3) = FSO.GetBaseName(FileItem.Name)    'Base Name
                Cells(LastBlankCell, 4) = FileItem.Attributes               'Attributes
                Cells(LastBlankCell, 5) = FileItem.path                     'Path
                Cells(LastBlankCell, 6) = FileItem.Size                     'Size
                Cells(LastBlankCell, 7) = FileItem.Type                     'Type
                Cells(LastBlankCell, 8) = FileExtension                     'Extension
                Cells(LastBlankCell, 9) = FileItem.DateCreated              'Date Created
                Cells(LastBlankCell, 10) = FileItem.DateLastAccessed        'Date Last Accessed
                Cells(LastBlankCell, 11) = FileItem.DateLastModified        'Date Last Modified
                Cells(LastBlankCell, 12) = GetFileDetails(FileItem, 27)     'Length

                LastBlankCell = LastBlankCell + 1   'next row number
            Case Else
                        
        End Select
    Next FileItem

    ' Get the Files of Subfolders. This is a Nested-Function Calling.
    If GetSubfolders = True Then
        For Each SubFolder In objFolder.Subfolders
            GetFilesInFolder SubFolder.path, True
        Next SubFolder
    End If

    Set objFolder = Nothing
    Set FSO = Nothing
'    Cells.EntireColumn.AutoFit
    Application.ScreenUpdating = True
End Sub

Public Function GetFileDetails(ByVal FileItem As Object, ByVal iColumn As Integer) As Variant
    Dim objShell, objFolder, objFolderItem
    Set objShell = CreateObject("Shell.Application")
    Set objFolder = objShell.Namespace(FileItem.ParentFolder.path)
    Set objFolderItem = objFolder.ParseName(FileItem.Name)
    GetFileDetails = objFolder.GetDetailsOf(objFolderItem, iColumn)   'Video length, iColumn=27
    Set objShell = Nothing
    Set objFolder = Nothing
    Set objFolderItem = Nothing
End Function

How to use this macro

You need creat a sub, and call the GetFilesInFolder procedure. The GetFilesInFolder procedure has two arguments:

1. The FolderPath argument: String, Specify the file directory you want to list, Eg. "D:\MyWorkbook".
2. The GetSubfolders parameter: Boolean, True or False, if you want to list subfolders, set it to True, otherwise set it to False.

For example: Get the folder "D:\Excel Functions" and subfolders file information:

Sub RunThisMacroToTest()
    GetFilesInFolder "D:\Excel Functions", True 'call GetFilesInFolder sub
End Sub

Don't get subfolders:

Sub RunThisMacroToTest()
    GetFilesInFolder "D:\Excel Functions", False 'call GetFilesInFolder sub
End Sub

Examples

Add more file information in new columns

For example, if you want to add Authors to a new column:

1. Add the Authors to the array (line 18-19), and replace Range("A1:L1").Value to Range("A1:N1").Value:

   Range("A1:N1").Value = Array("#", "Name", "Base Name", "Attributes", "Path", "Size", _
       "Type", "Extension", "Date Created", "Date Last Accessed", "Date Last Modified", "Length", "Authors")

2. In the main loop, line 40, add the code to get the Authors details.

   Cells(LastBlankCell, 13) = GetFileDetails(FileItem, 20)     'Authors

The following table shows the commonly used parameters of the GetDetailsOf method, the index number of Authors in the table is 20.

You can get the content of this table by running the following macro, of course you can also change the parameters to get more, Eg. change 35 to 100.

Sub GetItemName()
    'Get the Item Name and Index Number, used for GetDetailsOf
    Sheets.Add  'Add a new worksheet
    Dim objShell, objFolder
    Set objShell = CreateObject("Shell.Application")
    Set objFolder = objShell.Namespace("C:\")
    For i = 0 To 35 'You can change 35 to biger number
        Cells(i + 1, 1) = objFolder.GetDetailsOf(objFolder.Items, i) 'Item name
        Cells(i + 1, 2) = i 'Index Number
    Next
End Sub

Get all files information

If you don't need to filter specific file types and you want to get all files, just comment Select Case, replace line 26 to 44 with below code:

'        Select Case FileExtension
'            Case "MKV", "AVI", "MP4"    'Get "MKV", "AVI", "MP4" files
                Cells(LastBlankCell, 1) = LastBlankCell - 1                 '#
                Cells(LastBlankCell, 2) = FileItem.Name                     'Name
                Cells(LastBlankCell, 3) = FSO.GetBaseName(FileItem.Name)    'Base Name
                Cells(LastBlankCell, 4) = FileItem.Attributes               'Attributes
                Cells(LastBlankCell, 5) = FileItem.path                     'Path
                Cells(LastBlankCell, 6) = FileItem.Size                     'Size
                Cells(LastBlankCell, 7) = FileItem.Type                     'Type
                Cells(LastBlankCell, 8) = FileExtension                     'Extension
                Cells(LastBlankCell, 9) = FileItem.DateCreated              'Date Created
                Cells(LastBlankCell, 10) = FileItem.DateLastAccessed        'Date Last Accessed
                Cells(LastBlankCell, 11) = FileItem.DateLastModified        'Date Last Modified
                Cells(LastBlankCell, 12) = GetFileDetails(FileItem, 27)     'Length

                LastBlankCell = LastBlankCell + 1   'next row number
'            Case Else
'
'        End Select

Get specific file types

This macro only lists "MKV", "AVI", "MP4" files, what if you want to list "XLS", "XLSX" file types? Just replace line 27 with below code:

Case "XLS", "XLSX"    'Get "XLS", "XLSX" files

Change filter

If you want to filter by file size, e.g. list files larger than 5Mb (5Mb = 5*1024*1024 = 5242880 bytes)?
First, you need to define a variable, named FileSize, then using Select Case statements or If...Then...Else statements to determine the file size, replace line 22 to 45 with following code:

    ' Main loop
    Dim FileSize As LongLong
    For Each FileItem In objFolder.Files
        FileExtension = UCase(FSO.GetExtensionName(FileItem.Name)) 'Get file extension
        FileSize = FileItem.Size
        Select Case FileSize
            Case Is > 5242880   'file size > 5Mb
                Cells(LastBlankCell, 1) = LastBlankCell - 1                 '#
                Cells(LastBlankCell, 2) = FileItem.Name                     'Name
                Cells(LastBlankCell, 3) = FSO.GetBaseName(FileItem.Name)    'Base Name
                Cells(LastBlankCell, 4) = FileItem.Attributes               'Attributes
                Cells(LastBlankCell, 5) = FileItem.path                     'Path
                Cells(LastBlankCell, 6) = FileItem.Size                     'Size
                Cells(LastBlankCell, 7) = FileItem.Type                     'Type
                Cells(LastBlankCell, 8) = FileExtension                     'Extension
                Cells(LastBlankCell, 9) = FileItem.DateCreated              'Date Created
                Cells(LastBlankCell, 10) = FileItem.DateLastAccessed        'Date Last Accessed
                Cells(LastBlankCell, 11) = FileItem.DateLastModified        'Date Last Modified
                Cells(LastBlankCell, 12) = GetFileDetails(FileItem, 27)     'Length

                LastBlankCell = LastBlankCell + 1   'next row number
            Case Else

        End Select
    Next FileItem

Any more?

Yes!
For example: If you want to move the list file to a new folder, just add the following code to line 40:

FSO.MoveFile FileItem.path, "D:\My Favorites\Video\"

For example: what if you wanted the user to select a folder from a dialog instead of entering a specific folder? The following macro will help you.

Sub RunThisMacroToTest()
     'Select a folder to list file information
    
    Dim FolderPicker As FileDialog
    Dim myFolder As String
    
    'Select Folder with Dialog Box
    Set FolderPicker = Application.FileDialog(msoFileDialogFolderPicker)
    
    With FolderPicker
        .Title = "Select A Single Folder"
        .AllowMultiSelect = False

        If .Show <> -1 Then 'Check if user clicked cancel button
            Exit Sub
        Else
            GetFilesInFolder .SelectedItems(1), True    'call GetFilesInFolder sub
        End If
    End With
End Sub

For example: if you want to add a hyperlink to open the file, add the following code to line 40:

Cells(LastBlankCell, 13) = "=HYPERLINK(""" & FileItem.path & """,""" & "Open" & """)"   'Hyperlink

How to Use This Macro