Scans folder and its all subfolders (2 levels only) for files then put file details in list
Saves list in ListSheet starting cell ListA1
Post image is by Bing AI (AI-generated)
Sub ScanFolder(RootFolder, ListA1, ListSheet, Optional Wb = "This")
' Scan folder and its all subfolders (2 levels only) for files then put file details in list
' Saves list in ListSheet starting cell ListA1
' Example:
' ScanFolder("G:\SPC", "D4", "Files")
' Will read all folders in G:\SPC
' Then all files in each folder in G:\SPC, into sheet "Files" in current workbook starting cell D4
' > Clear list or add to list
' > loop through root folder to read sub folders
' > for each of subfolder, read files and details
' 2 level only
'
If Not IsThere(GetSon(RootFolder), GetPapa(RootFolder), True, True, True) Then GoTo ByeBye_Error1
If Wb = "This" Then Thi = ThisWorkbook.Name
Dim FSO As Object, fo As Object, Fi As Object
Set FSO = CreateObject("Scripting.FileSystemObject")
Row1 = WorksheetFunction.CountA(Workbooks(Thi).Worksheets(ListSheet).Range(ListA1).EntireColumn) - 2
GrRow1 = Range(ListA1).Row
Folders_Level1 = FoldersIn(FixPath(RootFolder), "", "|")
X1 = Row1 - 1
For Each Foo In Split(Folders_Level1, "|")
X1 = X1 + 1
Workbooks(Thi).Worksheets(ListSheet).Range(ListA1).Offset(X1, 0).Value = X1 + 1
Workbooks(Thi).Worksheets(ListSheet).Range(ListA1).Offset(X1, 1).Value = Foo
Workbooks(Thi).Worksheets(ListSheet).Range(ListA1).Offset(X1, 2).Value = FixPath(RootFolder)
Workbooks(Thi).Worksheets(ListSheet).Range(ListA1).Offset(X1, 3).Value = ""
Workbooks(Thi).Worksheets(ListSheet).Range(ListA1).Offset(X1, 4).FormulaR1C1 = _
"="""" & CountIF(C[-2]:C[-2],""" & FixPath(RootFolder) & Foo & """) & "" Objects"" "
' Loop inside files of this folder
Folders_Level2 = FoldersIn(FixPath(FixPath(RootFolder) & Foo), "", "|")
For Each Foo2 In Split(Folders_Level2, "|")
X1 = X1 + 1
Workbooks(Thi).Worksheets(ListSheet).Range(ListA1).Offset(X1, 0).Value = X1 + 1
Workbooks(Thi).Worksheets(ListSheet).Range(ListA1).Offset(X1, 1).Value = ChrW(9492) & ChrW(9472) & " " & Foo2
Workbooks(Thi).Worksheets(ListSheet).Range(ListA1).Offset(X1, 2).Value = FixPath(RootFolder) & Foo
Workbooks(Thi).Worksheets(ListSheet).Range(ListA1).Offset(X1, 3).Value = ""
Workbooks(Thi).Worksheets(ListSheet).Range(ListA1).Offset(X1, 4).FormulaR1C1 = _
"="""" & CountIF(C[-2]:C[-2],""" & FixPath(FixPath(RootFolder) & Foo) & Foo2 & """) & "" Objects"" "
GroupRow1 = GrRow1 + X1 + 1
' Loop in files in this folder
Files_Level3 = FilesIn("*.*", FixPath(FixPath(FixPath(RootFolder) & Foo) & Foo2), 0, "|")
For Each Fii In Split(Files_Level3, "|")
X1 = X1 + 1
Workbooks(Thi).Worksheets(ListSheet).Range(ListA1).Offset(X1, 0).Value = X1 + 1
Workbooks(Thi).Worksheets(ListSheet).Range(ListA1).Offset(X1, 1).Value = " " & ChrW(9492) & ChrW(9472) & " " & Fii
Workbooks(Thi).Worksheets(ListSheet).Range(ListA1).Offset(X1, 2).Value = FixPath(FixPath(RootFolder) & Foo) & Foo2
Workbooks(Thi).Worksheets(ListSheet).Range(ListA1).Offset(X1, 3).Value = Fii
FiSi = 0
On Error Resume Next
FiSi = FileSize_Formatted(FixPath(FixPath(FixPath(RootFolder) & Foo) & Foo2) & Fii, "")
On Error GoTo 0
Workbooks(Thi).Worksheets(ListSheet).Range(ListA1).Offset(X1, 4).Value = FiSi
If ActiveSheet.Name = ListSheet Then
Workbooks(Thi).Worksheets(ListSheet).Range(ListA1).Offset(X1, 0).Select
DoEvents
End If
Next
GroupRow2 = GrRow1 + X1
Next
Next
GoTo ByeBye
ByeBye_Error1:
MsgBox "Cannot find folder " & RootFolder, vbCritical
GoTo ByeBye
ByeBye:
Set FSO = Nothing
End Sub
' Scan folder and its all subfolders (2 levels only) for files then put file details in list
' Saves list in ListSheet starting cell ListA1
' Example:
' ScanFolder("G:\SPC", "D4", "Files")
' Will read all folders in G:\SPC
' Then all files in each folder in G:\SPC, into sheet "Files" in current workbook starting cell D4
' > Clear list or add to list
' > loop through root folder to read sub folders
' > for each of subfolder, read files and details
' 2 level only
'
If Not IsThere(GetSon(RootFolder), GetPapa(RootFolder), True, True, True) Then GoTo ByeBye_Error1
If Wb = "This" Then Thi = ThisWorkbook.Name
Dim FSO As Object, fo As Object, Fi As Object
Set FSO = CreateObject("Scripting.FileSystemObject")
Row1 = WorksheetFunction.CountA(Workbooks(Thi).Worksheets(ListSheet).Range(ListA1).EntireColumn) - 2
GrRow1 = Range(ListA1).Row
Folders_Level1 = FoldersIn(FixPath(RootFolder), "", "|")
X1 = Row1 - 1
For Each Foo In Split(Folders_Level1, "|")
X1 = X1 + 1
Workbooks(Thi).Worksheets(ListSheet).Range(ListA1).Offset(X1, 0).Value = X1 + 1
Workbooks(Thi).Worksheets(ListSheet).Range(ListA1).Offset(X1, 1).Value = Foo
Workbooks(Thi).Worksheets(ListSheet).Range(ListA1).Offset(X1, 2).Value = FixPath(RootFolder)
Workbooks(Thi).Worksheets(ListSheet).Range(ListA1).Offset(X1, 3).Value = ""
Workbooks(Thi).Worksheets(ListSheet).Range(ListA1).Offset(X1, 4).FormulaR1C1 = _
"="""" & CountIF(C[-2]:C[-2],""" & FixPath(RootFolder) & Foo & """) & "" Objects"" "
' Loop inside files of this folder
Folders_Level2 = FoldersIn(FixPath(FixPath(RootFolder) & Foo), "", "|")
For Each Foo2 In Split(Folders_Level2, "|")
X1 = X1 + 1
Workbooks(Thi).Worksheets(ListSheet).Range(ListA1).Offset(X1, 0).Value = X1 + 1
Workbooks(Thi).Worksheets(ListSheet).Range(ListA1).Offset(X1, 1).Value = ChrW(9492) & ChrW(9472) & " " & Foo2
Workbooks(Thi).Worksheets(ListSheet).Range(ListA1).Offset(X1, 2).Value = FixPath(RootFolder) & Foo
Workbooks(Thi).Worksheets(ListSheet).Range(ListA1).Offset(X1, 3).Value = ""
Workbooks(Thi).Worksheets(ListSheet).Range(ListA1).Offset(X1, 4).FormulaR1C1 = _
"="""" & CountIF(C[-2]:C[-2],""" & FixPath(FixPath(RootFolder) & Foo) & Foo2 & """) & "" Objects"" "
GroupRow1 = GrRow1 + X1 + 1
' Loop in files in this folder
Files_Level3 = FilesIn("*.*", FixPath(FixPath(FixPath(RootFolder) & Foo) & Foo2), 0, "|")
For Each Fii In Split(Files_Level3, "|")
X1 = X1 + 1
Workbooks(Thi).Worksheets(ListSheet).Range(ListA1).Offset(X1, 0).Value = X1 + 1
Workbooks(Thi).Worksheets(ListSheet).Range(ListA1).Offset(X1, 1).Value = " " & ChrW(9492) & ChrW(9472) & " " & Fii
Workbooks(Thi).Worksheets(ListSheet).Range(ListA1).Offset(X1, 2).Value = FixPath(FixPath(RootFolder) & Foo) & Foo2
Workbooks(Thi).Worksheets(ListSheet).Range(ListA1).Offset(X1, 3).Value = Fii
FiSi = 0
On Error Resume Next
FiSi = FileSize_Formatted(FixPath(FixPath(FixPath(RootFolder) & Foo) & Foo2) & Fii, "")
On Error GoTo 0
Workbooks(Thi).Worksheets(ListSheet).Range(ListA1).Offset(X1, 4).Value = FiSi
If ActiveSheet.Name = ListSheet Then
Workbooks(Thi).Worksheets(ListSheet).Range(ListA1).Offset(X1, 0).Select
DoEvents
End If
Next
GroupRow2 = GrRow1 + X1
Next
Next
GoTo ByeBye
ByeBye_Error1:
MsgBox "Cannot find folder " & RootFolder, vbCritical
GoTo ByeBye
ByeBye:
Set FSO = Nothing
End Sub
RootFolder, ListA1, ListSheet, Optional Wb = "This"
Views 127
Downloads 43
CodeID
DB ID
ANmarAmdeen
610
Revisions
v1.0
Friday
April
7
2023