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