VB - List all subfolders in a specific folder

Add a reference to the "Microsoft Scripting Runtime":

VB Code:

Private Sub Command1_Click()
    Dim strStartPath As String
    strStartPath = "C:\" 'ENTER YOUR START FOLDER HERE
    ListFolder strStartPath
End Sub
 
Private Sub ListFolder(sFolderPath As String)
    Dim FS As New FileSystemObject
    Dim FSfolder As Folder
    Dim subfolder As Folder
    Dim i As Integer
    
    Set FSfolder = FS.GetFolder(sFolderPath)
 
    For Each subfolder In FSfolder.SubFolders
        DoEvents
        i = i + 1
        Debug.Print subfolder
    Next subfolder
    Set FSfolder = Nothing
    MsgBox "Total sub folders in " & sFolderPath & " : " & i
End Sub

VB Code:

Dim Mypath as string, MyName as String,iCount as integer
iCount=0
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
         iCount=iCount+1
      End If   ' it represents a directory.
   End If
   MyName = Dir   ' Get next entry.
Loop
 
 
debug.print "No.of Folders in the selected path : " & iCount

Yep. Another way. Also works with files.

Also, could you maybe edit your post and add the vbcode tags?

Thanks

Never tried....How do I do it?

Edit your post above and put at the start of the code [vbcode] and at the end of it put [/vbcode] ;)

manavo11, how would you code it to find out if the directory exists or not, other then using an error handler? I tried using some of
faisalkm's code, but it didnt work.

To check if a dir exists use this :

VB Code:

Private Sub Form_Load()
    MsgBox DirExists("C:\windows")
    MsgBox DirExists("C:\testing")
End Sub
 
Private Function DirExists(sDir As String) As Boolean
    If Len(Dir$(sDir, vbDirectory)) Then
        DirExists = True
    End If
End Function

A real way:

VB Code:

Dim FS as Object
Set FS = CreateObject("Scripting.FileSystemObject")
If FS.FileExists("C:\myfile.txt") Then
     'It exists!
End If

Quote:

---

Originally posted by xjake88x
A real way:

VB Code:

Dim FS as Object
Set FS = CreateObject("Scripting.FileSystemObject")
If FS.FileExists("C:\myfile.txt") Then
     'It exists!
End If

---

Ack...using FSO and its late bound? Bad medicine.

Quote:

---

Originally posted by crptcblade
Ack...using FSO and its late bound? Bad medicine.

---

Plus it should be like this :

VB Code:

If FS.FolderExists("C:\some dir") Then

since the question regarded folder and not file existing...

VB Code:

Dim fs As Object
Set fs = CreateObject("Scripting.FileSystemObject")
Set fo = fs.GetFolder("c:\temp\)
For Each x In fo.SubFolders
  Debug.Print x.Name
Next

Another way

vb Code:

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
lParam As Any) As Long
 
Private Const LB_DIR = &H18D
 
Private Const DDL_DIRECTORY = &H10
Private Const DDL_ARCHIVE = &H20
Private Const DDL_EXCLUSIVE = &H8000
 
Private Sub Command1_Click()
    List1.Clear     
    SendMessage List1.hwnd, LB_DIR, DDL_EXCLUSIVE Or DDL_DIRECTORY, ByVal "C:\Windows\*.*"
End Sub