GandalfTheWhite
New Member
- Joined
- Jul 24, 2009
- Messages
- 37
I'm trying to produce a folder hierachy in Excel showing all Folders & Files, in exactly the same order Windows Explorer would.
My Code brings the Folders & Files back, but not in the exact order (it puts the files in a root folder first, rather than at the bottom of the list) and I also want to Indent at the right level for each folder / Files i.e.
Root
......Sub
...........File1
...........File2
.................Sub
......................File1
......Sub
...........File 1
.File1
.File2
here is my code, i'd appreciate any help with this. Thanks in advance.
Sub TestListFilesInFolder()
Workbooks.Add ' create a new workbook for the file list
' add headers
With Range("A1")
.Formula = "Folder contents:"
.Font.Bold = True
.Font.Size = 12
End With
Range("A3").Formula = "File Name:"
Range("B3").Formula = "File Size:"
Range("C3").Formula = "File Type:"
Range("D3").Formula = "Date Created:"
Range("E3").Formula = "Date Last Accessed:"
Range("F3").Formula = "Date Last Modified:"
Range("G3").Formula = "No OF Files in Folder:"
Range("H3").Formula = "Short File Name:"
Range("I3").Formula = "No Of Subfolders:"
Range("A3:I3").Font.Bold = True
ListFilesInFolder "C:\LocalStorage", True
End Sub
Sub ListFilesInFolder(SourceFolderName As String, IncludeSubfolders As Boolean)
Dim FSO As Scripting.FileSystemObject
Dim SourceFolder As Scripting.Folder, SubFolder As Scripting.Folder
Dim FileItem As Scripting.File
Dim r As Long
Set FSO = New Scripting.FileSystemObject
Set SourceFolder = FSO.GetFolder(SourceFolderName)
r = Range("A65536").End(xlUp).Row + 1
Cells(r, 1).Formula = SourceFolder.Name
Cells(r, 2).Formula = SourceFolder.Size
Cells(r, 3).Formula = SourceFolder.Type
Cells(r, 4).Formula = SourceFolder.DateCreated
Cells(r, 5).Formula = SourceFolder.DateLastAccessed
Cells(r, 6).Formula = SourceFolder.DateLastModified
Cells(r, 7).Formula = SourceFolder.Files.Count
Cells(r, 8).Formula = SourceFolder.Path
Cells(r, 9).Formula = SourceFolder.SubFolders.Count
With Range("A" & r, "I" & r)
.Font.Bold = True
With Range("A" & r)
End With
End With
r = r + 1 ' next row number
'
For Each FileItem In SourceFolder.Files
' display file properties
Cells(r, 1).Formula = FileItem.Name
Cells(r, 2).Formula = FileItem.Size
Cells(r, 3).Formula = FileItem.Type
Cells(r, 4).Formula = FileItem.DateCreated
Cells(r, 5).Formula = FileItem.DateLastAccessed
Cells(r, 6).Formula = FileItem.DateLastModified
Cells(r, 7).Formula = FileItem.Attributes
Cells(r, 8).Formula = FileItem.Path
If FileItem.Path = FileItem.Path Then
With Range("A" & r)
.Indentlevel = Indentlevel
End With
Else
With Range("A" & r)
.Indentlevel = Indentlevel - identlevel
End With
End If
r = r + 1 ' next row number
Next FileItem
If IncludeSubfolders Then
For Each SubFolder In SourceFolder.SubFolders
With Range("A" & r)
.Indentlevel = 1
End With
ListFilesInFolder SubFolder.Path, True
Next SubFolder
End If
Columns("A:H").AutoFit
With Range("A:A")
.HorizontalAlignment = xlLeft
End With
Set FileItem = Nothing
Set SourceFolder = Nothing
Set FSO = Nothing
ActiveWorkbook.Saved = True
End Sub
My Code brings the Folders & Files back, but not in the exact order (it puts the files in a root folder first, rather than at the bottom of the list) and I also want to Indent at the right level for each folder / Files i.e.
Root
......Sub
...........File1
...........File2
.................Sub
......................File1
......Sub
...........File 1
.File1
.File2
here is my code, i'd appreciate any help with this. Thanks in advance.
Sub TestListFilesInFolder()
Workbooks.Add ' create a new workbook for the file list
' add headers
With Range("A1")
.Formula = "Folder contents:"
.Font.Bold = True
.Font.Size = 12
End With
Range("A3").Formula = "File Name:"
Range("B3").Formula = "File Size:"
Range("C3").Formula = "File Type:"
Range("D3").Formula = "Date Created:"
Range("E3").Formula = "Date Last Accessed:"
Range("F3").Formula = "Date Last Modified:"
Range("G3").Formula = "No OF Files in Folder:"
Range("H3").Formula = "Short File Name:"
Range("I3").Formula = "No Of Subfolders:"
Range("A3:I3").Font.Bold = True
ListFilesInFolder "C:\LocalStorage", True
End Sub
Sub ListFilesInFolder(SourceFolderName As String, IncludeSubfolders As Boolean)
Dim FSO As Scripting.FileSystemObject
Dim SourceFolder As Scripting.Folder, SubFolder As Scripting.Folder
Dim FileItem As Scripting.File
Dim r As Long
Set FSO = New Scripting.FileSystemObject
Set SourceFolder = FSO.GetFolder(SourceFolderName)
r = Range("A65536").End(xlUp).Row + 1
Cells(r, 1).Formula = SourceFolder.Name
Cells(r, 2).Formula = SourceFolder.Size
Cells(r, 3).Formula = SourceFolder.Type
Cells(r, 4).Formula = SourceFolder.DateCreated
Cells(r, 5).Formula = SourceFolder.DateLastAccessed
Cells(r, 6).Formula = SourceFolder.DateLastModified
Cells(r, 7).Formula = SourceFolder.Files.Count
Cells(r, 8).Formula = SourceFolder.Path
Cells(r, 9).Formula = SourceFolder.SubFolders.Count
With Range("A" & r, "I" & r)
.Font.Bold = True
With Range("A" & r)
End With
End With
r = r + 1 ' next row number
'
For Each FileItem In SourceFolder.Files
' display file properties
Cells(r, 1).Formula = FileItem.Name
Cells(r, 2).Formula = FileItem.Size
Cells(r, 3).Formula = FileItem.Type
Cells(r, 4).Formula = FileItem.DateCreated
Cells(r, 5).Formula = FileItem.DateLastAccessed
Cells(r, 6).Formula = FileItem.DateLastModified
Cells(r, 7).Formula = FileItem.Attributes
Cells(r, 8).Formula = FileItem.Path
If FileItem.Path = FileItem.Path Then
With Range("A" & r)
.Indentlevel = Indentlevel
End With
Else
With Range("A" & r)
.Indentlevel = Indentlevel - identlevel
End With
End If
r = r + 1 ' next row number
Next FileItem
If IncludeSubfolders Then
For Each SubFolder In SourceFolder.SubFolders
With Range("A" & r)
.Indentlevel = 1
End With
ListFilesInFolder SubFolder.Path, True
Next SubFolder
End If
Columns("A:H").AutoFit
With Range("A:A")
.HorizontalAlignment = xlLeft
End With
Set FileItem = Nothing
Set SourceFolder = Nothing
Set FSO = Nothing
ActiveWorkbook.Saved = True
End Sub
Last edited: