How To List All Folders And Subfolders In Excel?

Vasia

New Member
Joined
Jun 27, 2020
Messages
1
Office Version
  1. 2016
Platform
  1. Windows
I found this code and need help. I am trying to do two things.

1. add Number Format to make all columns as text. I have tried but can not make it work. Where would I place it?
Range("A:V").NumberFormat = "@"

2. when the code runs it opens and save it new Worksheet. How can I change the code to add a sheet and use the folder name from "Choose the folder" option?

Thanks

Vasia

VBA Code:
Sub FolderNames()
'Update 20141027
Application.ScreenUpdating = False
Dim xPath As String
Dim xWs As Worksheet
Dim fso As Object, j As Long, folder1 As Object
With Application.FileDialog(msoFileDialogFolderPicker)
    .Title = "Choose the folder"
    .Show
End With
On Error Resume Next
xPath = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1) & "\"
Application.Workbooks.Add
Set xWs = Application.ActiveSheet
xWs.Cells(1, 1).Value = xPath
xWs.Cells(2, 1).Resize(1, 5).Value = Array("Path", "Dir", "Name", "Date Created", "Date Last Modified")
Set fso = CreateObject("Scripting.FileSystemObject")
Set folder1 = fso.getFolder(xPath)
getSubFolder folder1
xWs.Cells(2, 1).Resize(1, 5).Interior.Color = 65535
xWs.Cells(2, 1).Resize(1, 5).EntireColumn.AutoFit
Application.ScreenUpdating = True
End Sub
Sub getSubFolder(ByRef prntfld As Object)
Dim SubFolder As Object
Dim subfld As Object
Dim xRow As Long
For Each SubFolder In prntfld.SubFolders
    xRow = Range("A1").End(xlDown).Row + 1
    Cells(xRow, 1).Resize(1, 5).Value = Array(SubFolder.Path, Left(SubFolder.Path, InStrRev(SubFolder.Path, "\")), SubFolder.Name, SubFolder.DateCreated, SubFolder.DateLastModified)
Next SubFolder
For Each subfld In prntfld.SubFolders
    getSubFolder subfld
Next subfld
End Sub
 
Last edited by a moderator:

Excel Facts

Last used cell?
Press Ctrl+End to move to what Excel thinks is the last used cell.
Hi Vasia

I ran your code on a folder on my computer, and the screen capture below shows you the result.
1612108492028.png


In answer to your points:

(1) I don't understand your point about changing the number format so that the columns are text. As you can see from my screen capture, they already are in text format. If I applied the custom fromat "@" to them, they look exactly the same (which is what I would expect).

(2) Your code creates a new workbook (Application.Workbooks.Add). If what you're asking for is code that will add a new worksheet to your current workbook, then I would suggest delete that line of code I just referenced, and change:

VBA Code:
Application.Workbooks.Add
Set xWs = Application.ActiveSheet
to
VBA Code:
Set xWs = Application.ActiveWorkbook.Sheets.Add

Finally, your code already uses the selected folder name, so with the above change, I'm hoping it works the way you want it to. Let me know if I've misunderstood anything. Thanks.
 
Upvote 0

Forum statistics

Threads
1,215,743
Messages
6,126,609
Members
449,321
Latest member
syzer

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