I have some code that will list all the files in a particular folder. Is
there a way to do the same with just the names of folders in a directory?

Sub ListDir()
Dim i As Long
LocDir = InputBox("Copy & paste the directory you need to have listed.")
With Application.FileSearch
.NewSearch
.LookIn = LocDir
.SearchSubFolders = False
.MatchTextExactly = False
.FileType = msoFileTypeAllFiles
If .Execute(msoSortByFileName) 0 Then
MsgBox "There were " & .FoundFiles.Count & " file(s) found."
For i = 1 To .FoundFiles.Count
Cells(i, 2).Value = .FoundFiles(i)
Next i
Else
MsgBox "There were no files found."
End If
End With

Columns("B:B").Select
Selection.Replace What:=LocDir, Replacement:="" _
, LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False
Selection.Replace What:="\", Replacement:="" _
, LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False

Range("A1").Select

End Sub

One way:

Option Explicit
Sub testme01()

Dim myFolders() As String
Dim fCtr As Long
Dim myName As String
Dim myPath As String

myPath = "C:\my documents\"
If Right(myPath, 1) < "\" Then
myPath = myPath & "\"
End If

myName = Dir(myPath, vbDirectory)

If myName = "" Then
MsgBox "no folders found"
Exit Sub
End If

'get the list of files
fCtr = 0
Do While myName < ""
If myName < "." _
And myName < ".." Then
If GetAttr(myPath & myName) = vbDirectory Then
fCtr = fCtr + 1
ReDim Preserve myFolders(1 To fCtr)
myFolders(fCtr) = myName
End If
End If
myName = Dir()
Loop

If fCtr 0 Then
For fCtr = LBound(myFolders) To UBound(myFolders)
Debug.Print myFolders(fCtr)
Next fCtr
End If
End Sub


Another way is to use the FileScriptingObject:

Option Explicit
Sub testme02()

Dim myPath As String

Dim FSO As Object
Dim FSOFolder As Object
Set FSO = CreateObject("Scripting.FileSystemObject")

' Dim FSO As FileSystemObject
' Dim FSOFolder As Folder
' Set FSO = New FileSystemObject

myPath = "C:\my documents\"

If FSO.FolderExists(myPath) Then
For Each FSOFolder In FSO.GetFolder(myPath).SubFolders
Debug.Print FSOFolder.Name
Next FSOFolder
End If
End Sub

Dominique Feteau wrote:

I have some code that will list all the files in a particular folder. Is
there a way to do the same with just the names of folders in a directory?

Sub ListDir()
Dim i As Long
LocDir = InputBox("Copy & paste the directory you need to have listed.")
With Application.FileSearch
.NewSearch
.LookIn = LocDir
.SearchSubFolders = False
.MatchTextExactly = False
.FileType = msoFileTypeAllFiles
If .Execute(msoSortByFileName) 0 Then
MsgBox "There were " & .FoundFiles.Count & " file(s) found."
For i = 1 To .FoundFiles.Count
Cells(i, 2).Value = .FoundFiles(i)
Next i
Else
MsgBox "There were no files found."
End If
End With

Columns("B:B").Select
Selection.Replace What:=LocDir, Replacement:="" _
, LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False
Selection.Replace What:="\", Replacement:="" _
, LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False

Range("A1").Select

End Sub

--

Dave Peterson

Note :
Another way is to use the FileScriptingObject:

This one will also list Hidden folders and if you do it on C:\ for example also
Program Files, MSOCache, RECYCLER, System Volume Information



--
Regards Ron de Bruin
http://www.rondebruin.nl



"Dave Peterson" wrote in message ...
One way:

Option Explicit
Sub testme01()

Dim myFolders() As String
Dim fCtr As Long
Dim myName As String
Dim myPath As String

myPath = "C:\my documents\"
If Right(myPath, 1) < "\" Then
myPath = myPath & "\"
End If

myName = Dir(myPath, vbDirectory)

If myName = "" Then
MsgBox "no folders found"
Exit Sub
End If

'get the list of files
fCtr = 0
Do While myName < ""
If myName < "." _
And myName < ".." Then
If GetAttr(myPath & myName) = vbDirectory Then
fCtr = fCtr + 1
ReDim Preserve myFolders(1 To fCtr)
myFolders(fCtr) = myName
End If
End If
myName = Dir()
Loop

If fCtr 0 Then
For fCtr = LBound(myFolders) To UBound(myFolders)
Debug.Print myFolders(fCtr)
Next fCtr
End If
End Sub


Another way is to use the FileScriptingObject:

Option Explicit
Sub testme02()

Dim myPath As String

Dim FSO As Object
Dim FSOFolder As Object
Set FSO = CreateObject("Scripting.FileSystemObject")

' Dim FSO As FileSystemObject
' Dim FSOFolder As Folder
' Set FSO = New FileSystemObject

myPath = "C:\my documents\"

If FSO.FolderExists(myPath) Then
For Each FSOFolder In FSO.GetFolder(myPath).SubFolders
Debug.Print FSOFolder.Name
Next FSOFolder
End If
End Sub

Dominique Feteau wrote:

I have some code that will list all the files in a particular folder. Is
there a way to do the same with just the names of folders in a directory?

Sub ListDir()
Dim i As Long
LocDir = InputBox("Copy & paste the directory you need to have listed.")
With Application.FileSearch
.NewSearch
.LookIn = LocDir
.SearchSubFolders = False
.MatchTextExactly = False
.FileType = msoFileTypeAllFiles
If .Execute(msoSortByFileName) 0 Then
MsgBox "There were " & .FoundFiles.Count & " file(s) found."
For i = 1 To .FoundFiles.Count
Cells(i, 2).Value = .FoundFiles(i)
Next i
Else
MsgBox "There were no files found."
End If
End With

Columns("B:B").Select
Selection.Replace What:=LocDir, Replacement:="" _
, LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False
Selection.Replace What:="\", Replacement:="" _
, LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False

Range("A1").Select

End Sub

--

Dave Peterson

Straight from VBA help on the Dir function:
' Display the names in C:\ that represent directories.
MyPath = "C:\" ' Set the path.
MyName = Dir(MyPath, vbDirectory) ' Retrieve the first entry.
Do While MyName < "" ' Start the loop.
' Ignore the current directory and the encompassing directory.
If MyName < "." And MyName < ".." Then
' Use bitwise comparison to make sure MyName is a directory.
If (GetAttr(MyPath & MyName) And vbDirectory) = vbDirectory Then
Debug.Print MyName ' Display entry only if it
End If ' it represents a directory.
End If
MyName = Dir ' Get next entry.
Loop

"Dominique Feteau" wrote:

I have some code that will list all the files in a particular folder. Is
there a way to do the same with just the names of folders in a directory?

Sub ListDir()
Dim i As Long
LocDir = InputBox("Copy & paste the directory you need to have listed.")
With Application.FileSearch
.NewSearch
.LookIn = LocDir
.SearchSubFolders = False
.MatchTextExactly = False
.FileType = msoFileTypeAllFiles
If .Execute(msoSortByFileName) 0 Then
MsgBox "There were " & .FoundFiles.Count & " file(s) found."
For i = 1 To .FoundFiles.Count
Cells(i, 2).Value = .FoundFiles(i)
Next i
Else
MsgBox "There were no files found."
End If
End With

Columns("B:B").Select
Selection.Replace What:=LocDir, Replacement:="" _
, LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False
Selection.Replace What:="\", Replacement:="" _
, LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False

Range("A1").Select

End Sub