Wednesday, July 16, 2014

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
--------------------------------------------------------------------------------------------------------

No comments:

Post a Comment

Hi User, Thank You for visiting My Blog. Please post your genuine Feedback or comments only related to this Blog Posts. Please do not post any Spam comments or Advertising kind of comments which will be Ignored.

Featured Post from this Blog

How to compare Current Snapshot Data with Previous Snapshot in Power BI

How to Dynamically compare two Snapshots Data in Power BI Scenario: Suppose, we have a sample Sales data, which is stored with Monthly Snaps...

Popular Posts from this Blog