Can someone Check My Code, it works but...

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
 
Last edited:

Excel Facts

Spell Check in Excel
Press F7 to start spell check in Excel. Be careful, by default, Excel does not check Capitalized Werds (whoops)
This isn't quite the layout you asked for (since that wouldn't work with recursion), but will it do:
Code:
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:\", True, 4, 0
End Sub
Sub ListFilesInFolder(SourceFolderName As String, IncludeSubfolders As Boolean, lngRow As Long, lngIndent As Long)
   Dim FSO As Scripting.FileSystemObject
   Dim SourceFolder As Scripting.Folder, SubFolder As Scripting.Folder
   Dim FileItem As Scripting.File
   Set FSO = New Scripting.FileSystemObject
   Set SourceFolder = FSO.GetFolder(SourceFolderName)
   Cells(lngRow, 1).Formula = SourceFolder.Name
   Cells(lngRow, 2).Formula = SourceFolder.Size
   Cells(lngRow, 3).Formula = SourceFolder.Type
   Cells(lngRow, 4).Formula = SourceFolder.DateCreated
   Cells(lngRow, 5).Formula = SourceFolder.DateLastAccessed
   Cells(lngRow, 6).Formula = SourceFolder.DateLastModified
   Cells(lngRow, 7).Formula = SourceFolder.Files.Count
   Cells(lngRow, 8).Formula = SourceFolder.Path
   Cells(lngRow, 9).Formula = SourceFolder.SubFolders.Count
   
   Range("A" & lngRow, "I" & lngRow).Font.Bold = True
   '
   If IncludeSubfolders Then
      For Each SubFolder In SourceFolder.SubFolders
         lngRow = lngRow + 1 ' next row number
         Range("A" & lngRow).IndentLevel = lngIndent
         ListFilesInFolder SubFolder.Path, True, lngRow, lngIndent + 1
      Next SubFolder
   End If
   lngRow = lngRow + 1
   For Each FileItem In SourceFolder.Files
      ' display file properties
      Cells(lngRow, 1).Formula = FileItem.Name
      Cells(lngRow, 2).Formula = FileItem.Size
      Cells(lngRow, 3).Formula = FileItem.Type
      Cells(lngRow, 4).Formula = FileItem.DateCreated
      Cells(lngRow, 5).Formula = FileItem.DateLastAccessed
      Cells(lngRow, 6).Formula = FileItem.DateLastModified
      Cells(lngRow, 7).Formula = FileItem.Attributes
      Cells(lngRow, 8).Formula = FileItem.Path
      If FileItem.Path = FileItem.Path Then
         Range("A" & lngRow).IndentLevel = lngIndent
      Else
         Range("A" & lngRow).IndentLevel = lngIndent
      End If
      lngRow = lngRow + 1 ' next row number
   Next FileItem
   Columns("A:H").AutoFit
   Range("A:A").HorizontalAlignment = xlLeft
   
   Set FileItem = Nothing
   Set SourceFolder = Nothing
   Set FSO = Nothing
   ActiveWorkbook.Saved = True
End Sub
 
Upvote 0

Forum statistics

Threads
1,223,230
Messages
6,170,883
Members
452,364
Latest member
springate

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top