List Folder Names

[Apelcius]

i've posted the code of interest below

found this in another thread (and thanks btw for this awesome stuff).

i love that it allows search, then goes in each subfolder.

but, i just need a basic code for letting search, then listing the folders (only folder, not files), starting the selected cell, and going down that column.


Option Explicit

Sub GetFileNames()

Dim xRow As Long
Dim xDirect$, xFname$, InitialFoldr$

InitialFoldr$ = "G:\" '<<< Startup folder to begin searching from

With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = Application.DefaultFilePath & "\"
.Title = "Please select a folder to list Files from"
.InitialFileName = InitialFoldr$
.Show
If .SelectedItems.Count <> 0 Then
xDirect$ = .SelectedItems(1) & "\"
xFname$ = Dir(xDirect$, 7)
Do While xFname$ <> ""
ActiveCell.Offset(xRow) = xFname$
xRow = xRow + 1
xFname$ = Dir
Loop
End If
End With
End Sub

[snb]

That code doesn't find any subfolder as far as I can see.


Sub M_snb()
c00="G:\"

sn=split(createobject("wscript.shell").exec("cmd /c Dir """ & c00 & "*."" /b/s").stdout.readall,vbcrlf)
sheets(1).cells(1).resize(ubound(sn)+1)=application.transpose(sn)
End Sub

[Apelcius]

well, not looking for it to. not too certain what that code does for it. does your code paste directly?

i just need it to prompt me to a directory, then list all the folders in that directory.

[snb]

You can enter the directory after c00=