Macro to list folder names within a directory

Hi guys,

Thanks for all the help recently but I am not yet done! Now i'm looking for a macro which within a sheet named "foldernamedump" will list in a column the folder names within a directory I specify.

I have seen a couple of sample codes but I just cant seem to get them working at all so I think its best to start from scratch and the work i get supplied here is always perfect.

I also want the macro to clear the contents of the sheet before it loads again just to ensure there is no old data within the sheet.

Thank you for any help

Hello munkee,

This macro will all the folders in a given directory. The list is output to the "Sheet1" starting in cell "A2". The folder name, path, and size are printed in the same row. You can change the directory, worksheet, and starting cell. They are all marked in red.

Sub ListFoldersAndInfo()

  Dim FSO As Object
  Dim Folder As Object
  Dim FolderName As String
  Dim R As Long
  Dim Rng As Range
  Dim SubFolder As Object
  Dim Wks As Worksheet
  
  'Parent Directory - Change this to whichever directory you want to use
    FolderName = "C:\Documents and settings\Owner\My Documents"
    
    Set Wks = Worksheets("Sheet1")
    Set Rng = Wks.Range("A2")
    Wks.UsedRange.Offset(1, 0).ClearContents
    
    Set FSO = CreateObject("Scripting.FileSystemObject")
    
      Set Folder = FSO.GetFolder(FolderName)
      R = 1
      Rng.Cells(R, 1) = Folder.Name
      Rng.Cells(R, 2) = Folder.Path
      Rng.Cells(R, 3) = Folder.Size
      
        For Each Folder In Folder.SubFolders
          R = R + 1
          Rng.Cells(R, 1) = Folder.Name
          Rng.Cells(R, 2) = Folder.Path
          Rng.Cells(R, 3) = Folder.Size
        Next Folder
        
    Set FSO = Nothing
         
End Sub

Try this

Sub ListFolders()
Dim fso
Sheets("foldernamedump").Cells.Clear
Set fso = CreateObject("Scripting.FileSystemObject")
Root = Application.InputBox("Please enter path")
If Right(Root, 1) <> "\" Then Root = Root & "\"
Set Folder = fso.getfolder(Root)
Set SubFolders = Folder.SubFolders
For Each SubFolder In SubFolders
    Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) = SubFolder.Name
Next SubFolder
Set fso = Nothing
End Sub

Hello Mustang,

Your post does not comply with Rule 2 of our Forum RULES. Don't post a question in the thread of another member -- start your own thread. If you feel it's particularly relevant, provide a link to the other thread.