How to List or Fetch all the details of Files and SubFolders from a Specific Path using Excel VBA Macro

Macro to List or Fetch all the details of Files and SubFolders with Files from a Folder or Specific Path

Sub List_All_SubFolders_Files()
    Dim SrcPath As String       
    Dim FSO As Object   
    Dim SrcFolder As Object
    Dim S_Folder As Object
    Dim S_File As Object    
    Dim FileExt As String
    Dim WS As Object    
     
    SrcPath = ActiveSheet.Range("B1").Value
    Set WS = ThisWorkbook.ActiveSheet
        
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set SrcFolder = FSO.GetFolder(SrcPath)

    If Right(SrcPath, 1) = "\" Then
        SrcPath = Left(SrcPath, Len(SrcPath) - 1)
    End If
    
    If (SrcFolder.Files.Count = 0) And (SrcFolder.SubFolders.Count = 0) Then
        MsgBox "Src Folder Doesnot Have Any Subfolders/Files", vbOKCancel, 
                       "Src Folder Is Empty"
        Exit Sub
    End If

    ActiveSheet.Range("A3:G1000").Select
    Selection.Clear

    Z = 0
    K = 3

    MFC = SrcFolder.Files.Count 'Main Folder Files Count
    
        WS.Cells(K, 1) = SrcFolder.Name
        WS.Cells(K, 1).Interior.ColorIndex = 37
        WS.Cells(K, 1).Font.Bold = True
        WS.Cells(K, 2) = SrcFolder.Path
        WS.Cells(K, 3) = Round(SrcFolder.Size / 1024) & " KB"
        WS.Cells(K, 4) = SrcFolder.Type
        WS.Cells(K, 5) = SrcFolder.DateLastModified
        WS.Cells(K, 6).Select
        WS.Hyperlinks.Add Anchor:=Selection, Address:= _
                SrcFolder.Path, TextToDisplay:="Click Here to Open"
        
    If (Round((SrcFolder.Size / 1024) / 1024) = 0) Then
        WS.Cells(K, 7) = "<1 MB"
    Else
        WS.Cells(K, 7) = Round((SrcFolder.Size / 1024) / 1024) & " MB"
    End If
    K = K + 1

For Y = K To MFC
    For Each File In SrcFolder.Files
    
        M_File_Name = File.Name
        M_File_Path = File.Path
        M_File_Size = Round(File.Size / 1024) & " KB"
        
            If (Round((File.Size / 1024) / 1024) = 0) Then
                MB_File_Size = "<1 MB"
            Else
               MB_File_Size = Round((File.Size / 1024) / 1024) & " MB"
            End If
    
        M_File_Type = File.Type
        M_File_Modified = File.DateLastModified
        
        WS.Cells(Y, 1) = M_File_Name
        WS.Cells(Y, 2) = M_File_Path
        WS.Cells(Y, 3) = M_File_Size
        WS.Cells(Y, 4) = M_File_Type
        WS.Cells(Y, 5) = M_File_Modified
        WS.Cells(Y, 6).Select
        WS.Hyperlinks.Add Anchor:=Selection, Address:= _
                M_File_Path, TextToDisplay:="Click Here to Open"
        WS.Cells(Y, 7) = MB_File_Size
        Y = Y + 1
        Z = Z + 1
    
    Next File
Next Y

K = K + Z

If (SrcFolder.SubFolders.Count > 0) Then

    For Each SubFolder In SrcFolder.SubFolders
    If (SubFolder.Files.Count > 0) Then
    
            S_Folder_Name = SubFolder.Name
            S_Folder_Path = SubFolder.Path
            S_Folder_Size = Round(SubFolder.Size / 1024) & " KB"
            
                If (Round((SubFolder.Size / 1024) / 1024) = 0) Then
                    SMB_Folder_Size = "<1 MB"
                Else
                    SMB_Folder_Size = Round((SubFolder.Size / 1024) / 1024) & " MB"
                End If
            
            S_Folder_Type = SubFolder.Type
            S_Folder_Modified = SubFolder.DateLastModified
            
            SFC = SubFolder.Files.Count ' Sub Folder Files Count
        
        For X = K To (K + SFC)
        
            WS.Cells(X, 1) = S_Folder_Name
            WS.Cells(X, 1).Interior.ColorIndex = 36
            
            WS.Cells(X, 1).Font.Bold = True
            WS.Cells(X, 2) = S_Folder_Path
            WS.Cells(X, 3) = S_Folder_Size
            WS.Cells(X, 4) = S_Folder_Type
            WS.Cells(X, 5) = S_Folder_Modified
            WS.Cells(X, 6).Select
            WS.Hyperlinks.Add Anchor:=Selection, Address:= _
                    S_Folder_Path, TextToDisplay:="Click Here to Open"
            WS.Cells(X, 7) = SMB_Folder_Size
       
            For Each File In SubFolder.Files
                X = X + 1
                S_File_Name = File.Name
                S_File_Path = File.Path
                S_File_Size = Round(File.Size / 1024) & " KB"
                
                        If (Round((File.Size / 1024) / 1024) = 0) Then
                            SMB_File_Size = "<1 MB"
                        Else
                           SMB_File_Size = Round((File.Size / 1024) / 1024) & " MB"
                        End If
            
                S_File_Type = File.Type
                S_File_Modified = File.DateLastModified
                
                WS.Cells(X, 1) = S_File_Name
                WS.Cells(X, 2) = S_File_Path
                WS.Cells(X, 3) = S_File_Size
                WS.Cells(X, 4) = S_File_Type
                WS.Cells(X, 5) = S_File_Modified
                WS.Cells(X, 6).Select
                WS.Hyperlinks.Add Anchor:=Selection, Address:= _
                        S_File_Path, TextToDisplay:="Click Here to Open"
                WS.Cells(X, 7) = SMB_File_Size
            
                K = K + 1
            Next File

            K = K + 1
        Next X

    End If
    Next SubFolder
End If

Set FSO = Nothing

End Sub

--------------------------------------------------------------------------------------------------------

Thanks, TAMATAM ; Business Intelligence & Analytics Professional

--------------------------------------------------------------------------------------------------------