CountFolder

Public Sub GetAllDrivesFolders(tvwTree As Control, nodParentNode As Node)
    'this routine uses a pre-dimmed array to speed up
    'processing.  Initially, the array is DIM'med to
    '200 elements; in the While loop it is increased
    'another 200 elements when "found Mod 200 = 0"
    '(or the number found divided by 200 equals 0).
    'At the end of the loop, it is resized down to the
    'total found.  This is significantly faster than
    'using a Redim Preserve statement for each element found.
    Dim nodX As Node
    
    Dim WFD As WIN32_FIND_DATA
    Dim hFile As Long
    
    Dim sFile As String
    Dim sPath As String
    
    Dim i As Integer
    Dim r As Long
    Dim found As Integer
    
    'assign the fullpath property to the path to search,
    'assuring that the path is qualified.
    If Right$(nodParentNode.FullPath, 1)   "\" Then
        sPath = nodParentNode.FullPath & "\"
    Else: sPath = nodParentNode.FullPath
    End If
    
    'strip off the "My Computer" from the FullPath property.
    'The actual fullpath is "My Computer\C:\", however,
    'the Findxxx APIs want only the qualified path, i.e "C:\".
    sPath = Mid$(sPath, 13, Len(sPath))
    'find the first file matching the parameter \*.*
    hFile = FindFirstFile(sPath & "*.*" & Chr$(0), WFD)
    
    'reset the counter flag
    found = 0
    ReDim fArray(200)
    
    If hFile  -1 Then
        sFile = TrimNull(WFD.cFileName)
        
        WFD.dwFileAttributes = vbDirectory
        
        While FindNextFile(hFile, WFD)
            
            sFile = TrimNull(WFD.cFileName)
            
            'ignore the 2 standard root entries
            If (sFile   ".") And (sFile   "..") Then
                
                If (WFD.dwFileAttributes And vbDirectory) Then
                    
                    found = found + 1
                    
                    'if found is at 200, then add some more array elements
                    If found Mod 200 = 0 Then ReDim Preserve fArray(found + 100)
                    
                    fArray(found) = sFile
                    
                End If
                
            End If
            
        Wend
        
    End If
    
    r = FindClose(hFile)
    
    'trim down the array to equal the elements found
    ReDim Preserve fArray(found)
    
    'add the folders to the treeview
    For i = 1 To found
        
        Set nodX = tvwTree.Nodes.Add(nodParentNode.Key, _
            tvwChild, _
            sPath & fArray(i) & "Dir", _
            fArray(i), 8, 9)
        
        'and get some more
        If LoadAll Then GetAllDrivesFolders tvwTree, nodX
        
    Next i
    
    nodParentNode.Sorted = displaySorted
    nodParentNode.Expanded = displayExpanded
End Sub

Sub GetNextLevelFolders(tvwTree As Control, nodParentNode As Node)
    
    Dim nodX As Node
    
    Dim WFD As WIN32_FIND_DATA
    Dim hFile As Long
    
    Dim sFile As String
    Dim sPath As String
    
    Dim i As Integer
    Dim r As Long
    Dim found As Integer
    'assign the fullpath property to the path to search,
    'assuring that the path is qualified.
    If Right$(nodParentNode.FullPath, 1)   "\" Then
        sPath = nodParentNode.FullPath & "\"
    Else: sPath = nodParentNode.FullPath
    End If
    'strip off the "My Computer" from the FullPath property.
    'The actual fullpath is "My Computer\C:\", however,
    'the Findxxx APIs want only the qualified path, i.e "C:\".
    sPath = Mid$(sPath, 13, Len(sPath))
    'find the first file matching the parameter \*.*
    hFile = FindFirstFile(sPath & "*.*" & Chr$(0), WFD)
    
    If hFile   -1 Then
        
        sFile = TrimNull(WFD.cFileName)
        
        While FindNextFile(hFile, WFD)
            
            sFile = TrimNull(WFD.cFileName)
            
            'ignore the 2 standard root entries
            If (sFile   ".") And (sFile   "..") Then
                
                If (WFD.dwFileAttributes And vbDirectory) Then
                    'add the item and its icon
                    Set nodX = tvwTree.Nodes.Add(nodParentNode.Key, _
                        tvwChild, _
                        sPath & sFile & "Dir", _
                        sFile, 8, 9)
                End If
                
            End If
            
        Wend
        
    End If
    
    r = FindClose(hFile)
    
    nodParentNode.Sorted = displaySorted
    nodParentNode.Expanded = displayExpanded
    
End Sub

Private Sub Form_Load()
    'centre the form
    Me.Move (Screen.Width - Me.Width) / 2, (Screen.Height - Me.Height) / 2
    'set initial options
    chkSort.Value = 1
    chkExpanded.Value = 1
    optLoadType(0).Value = True
    'load the system drives
    GetSystemDrives
    'store the initial number of treeview elements for
    'later subtraction when presenting the total number
    'of files loaded (tvwControl_click routine)
    NoOfDrives = tvwControl.Nodes.Count
    lblMessage = "Set your Load options, then click any drive."
End Sub

Private Sub cmdEnd_Click()
    Unload Me
    Set Form1 = Nothing
    
End Sub

Private Sub chkExpanded_Click()
    displayExpanded = chkExpanded.Value = 1
End Sub

Private Sub chkSort_Click()
    displaySorted = chkSort.Value = 1
End Sub

Private Sub optLoadType_Click(Index As Integer)
    LoadAll = optLoadType(1).Value = True
End Sub

Private Sub GetSystemDrives()
    Dim nodX As Node
    Dim r As Long
    Dim allDrives As String
    Dim currDrive As String
    Dim drvIcon As Integer
    'assign the imagelist to the treeview
    tvwControl.ImageList = ImageList1
    'add a base "My Computer" to the tree
    Set nodX = tvwControl.Nodes.Add(, , "Root", "My Computer", 1, 1)
    nodX.Expanded = True
    'get the list of all available drives
    allDrives = rgbGetAvailableDrives()
    
    Do Until allDrives = Chr$(0)
        
        'strip off one drive item from the allDrives$
        currDrive = StripNulls(allDrives)
        
        'determine the appropriate imagelist icon to display
        drvIcon = GetDriveDisplayIcon(currDrive)
        
        'we can't have the trailing slash, so ..
        currDrive = Left$(currDrive, 2)
        
        'Add the drive to the treeview.
        Set nodX = tvwControl.Nodes.Add("Root", _
            tvwChild, _
            currDrive$ & "Dir", _
            currDrive$, drvIcon, drvIcon)
        nodX.Expanded = True
        
    Loop
    
    'force sorting of the drive letters
    nodX.Sorted = True
End Sub

Private Function rgbGetAvailableDrives() As String
    'returns a single string of available drive
    'letters, each separated by a chr$(0)
    Dim r As Long
    Dim tmp As String
    
    tmp = Space$(64)
    r = GetLogicalDriveStrings(Len(tmp), tmp)
    
    rgbGetAvailableDrives = Trim$(tmp)
End Function

Private Function GetDriveDisplayIcon(driveName) As Integer
    Dim dIcon As Integer
    
    Select Case GetDriveType(driveName)
        Case 0, 1:            dIcon = 1
        Case DRIVE_REMOVABLE:
            Select Case Left$(driveName, 1)
                Case "a", "b":  dIcon = 2
                Case Else:      dIcon = 5
            End Select
            
        Case DRIVE_FIXED:     dIcon = 3
        Case DRIVE_REMOTE:    dIcon = 6
        Case DRIVE_CDROM:     dIcon = 4
        Case DRIVE_RAMDISK:   dIcon = 7
    End Select
    
    GetDriveDisplayIcon = dIcon
    
End Function

Private Function StripNulls(startstr As String) As String
    'Take a string separated by a chr$(0), and split off 1 item, and
    'shorten the string so that the next item is ready for removal.
    Dim pos As Integer
    Dim c As Integer
    pos = InStr(startstr$, Chr$(0))
    
    If pos Then
        StripNulls = Mid$(startstr, 1, pos - 1)
        startstr = Mid$(startstr, pos + 1, Len(startstr))
        Exit Function
    End If
End Function

Private Sub tvwControl_Click()
    Dim nodX As Node
    'show a wait message for long searches
    lblMessage = "Searching drive " & _
        tvwControl.SelectedItem & _
        " for folders ... please wait"
    DoEvents
    'identify the selected node
    Set nodX = tvwControl.SelectedItem
    'verify it's valid
    If (UCase$(Right$(nodX.Key, 3)) = "DIR") And (nodX.Children = 0) Then
        
        'based on the user options, ...
        If LoadAll Then
            GetAllDrivesFolders tvwControl, nodX
        Else: GetNextLevelFolders tvwControl, nodX
        End If
        
    End If
    'subtract NoOfDrives because "My Computer" and the
    'initial drives loaded should not be counted as a folder
    lblMessage = "Total folders displayed : " & _
        tvwControl.Nodes.Count - NoOfDrives
    
End Sub

'Please note that if you select Load All Drive's Folders,
'and you have a large drive with many folders, the app may appear to
'hang as it retrieves the information. Therefore, save the project
'before running, in case you need to Ctrl-Alt-Del out of the routine.
 Enumerating Folders using FindFirstFile & FindNextFile API, AdvancedRelated
Related page Enumerating Folders using the FindFirstFile & FindNextFile
APIs has been completed.
This code demonstrates how to both recursively and singly search for all
folders on a target drive using the Win95/NT4 APIs FindFirstFile and
FindNextFile, and a routine to search just the selected folder.
The results are displayed in a treeview control, complete with the
appropriate icons for the type of drive installed, and folder icons for
the folders. The search depth (single level or all folders), as well as
options for sorting the folders and expanding on load are user-selectable.
For a discussion on the FindFirstFile, FindNextFile, and the WIN32_FIND_DATA
structure, see Enumerating Folders using FindFirstFile & FindNextFile.
Start a new project, and to the form add a command buttons (cmdEnd), a
Treeview control (tvwControl), an autosizing label (lblMessage), two
checkbox controls (chkExpanded and chkSort), and a control array of 2
option buttons (optLoadType(0) & optLoadType(1)), as indicated in the
illustration.
Add an imagelist to the form (ImageList1), and populate it with several
16x16 pixel icons.   If you would prefer, download a blank form containing
the imagelist icons used in this demo rather than construct them yourself.

Option Explicit
Public Const MAX_PATH = 260
'GetDriveType return values

Public Const DRIVE_REMOVABLE = 2
Public Const DRIVE_FIXED = 3
Public Const DRIVE_REMOTE = 4
Public Const DRIVE_CDROM = 5
Public Const DRIVE_RAMDISK = 6
Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Type WIN32_FIND_DATA
dwFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved0 As Long
dwReserved1 As Long
cFileName As String * MAX_PATH
cAlternate As String * 14
End Type
Public Declare Function GetDriveType _
Lib "kernel32" Alias "GetDriveTypeA" _
(ByVal nDrive As String) As Long
Public Declare Function GetLogicalDriveStrings _
Lib "kernel32" Alias "GetLogicalDriveStringsA" _
(ByVal nBufferLength As Long, _
ByVal lpBuffer As String) As Long
Public Declare Function FindFirstFile _
Lib "kernel32" Alias "FindFirstFileA" _
(ByVal lpFileName As String, _
lpFindFileData As WIN32_FIND_DATA) As Long
Public Declare Function FindNextFile _
Lib "kernel32" Alias "FindNextFileA" _
(ByVal hFindFile As Long, _
lpFindFileData As WIN32_FIND_DATA) As Long
Public Declare Function FindClose _
Lib "kernel32" (ByVal hFindFile As Long) As Long
'flags for the user options

Public displayExpanded As Boolean 'integer for VB4
Public displaySorted As Boolean 'integer for VB4
Public NoOfDrives As Integer
Public LoadAll As Boolean 'integer for VB4
Public Function TrimNull(startstr As String) As String
Dim pos As Integer
pos = InStr(startstr, Chr$(0))

If pos Then
TrimNull = Left$(startstr, pos - 1)
Exit Function
End If

'if this far, there was

'no Chr$(0), so return the string

TrimNull = startstr

End Function

Public Sub GetAllDrivesFolders(tvwTree As Control, nodParentNode As Node)
'this routine uses a pre-dimmed array to speed up

'processing. Initially, the array is DIM'med to

'200 elements; in the While loop it is increased

'another 200 elements when "found Mod 200 = 0"

'(or the number found divided by 200 equals 0).

'At the end of the loop, it is resized down to the

'total found. This is significantly faster than

'using a Redim Preserve statement for each element found.

Dim nodX As Node

Dim WFD As WIN32_FIND_DATA
Dim hFile As Long

Dim sFile As String
Dim sPath As String

Dim i As Integer
Dim r As Long
Dim found As Integer

'assign the fullpath property to the path to search,

'assuring that the path is qualified.

If Right$(nodParentNode.FullPath, 1) "\" Then
sPath = nodParentNode.FullPath & "\"
Else: sPath = nodParentNode.FullPath
End If

'strip off the "My Computer" from the FullPath property.

'The actual fullpath is "My Computer\C:\", however,

'the Findxxx APIs want only the qualified path, i.e "C:\".

sPath = Mid$(sPath, 13, Len(sPath))
'find the first file matching the parameter \*.*

hFile = FindFirstFile(sPath & "*.*" & Chr$(0), WFD)

'reset the counter flag

found = 0
ReDim fArray(200)

If hFile -1 Then
sFile = TrimNull(WFD.cFileName)

WFD.dwFileAttributes = vbDirectory

While FindNextFile(hFile, WFD)

sFile = TrimNull(WFD.cFileName)

'ignore the 2 standard root entries

If (sFile ".") And (sFile "..") Then

If (WFD.dwFileAttributes And vbDirectory) Then

found = found + 1

'if found is at 200, then add some more array elements

If found Mod 200 = 0 Then ReDim Preserve fArray(found + 100)

fArray(found) = sFile

End If

End If

Wend

End If

r = FindClose(hFile)

'trim down the array to equal the elements found

ReDim Preserve fArray(found)

'add the folders to the treeview

For i = 1 To found

Set nodX = tvwTree.Nodes.Add(nodParentNode.Key, _
tvwChild, _
sPath & fArray(i) & "Dir", _
fArray(i), 8, 9)

'and get some more

If LoadAll Then GetAllDrivesFolders tvwTree, nodX

Next i

nodParentNode.Sorted = displaySorted
nodParentNode.Expanded = displayExpanded
End Sub

Sub GetNextLevelFolders(tvwTree As Control, nodParentNode As Node)

Dim nodX As Node

Dim WFD As WIN32_FIND_DATA
Dim hFile As Long

Dim sFile As String
Dim sPath As String

Dim i As Integer
Dim r As Long
Dim found As Integer
'assign the fullpath property to the path to search,

'assuring that the path is qualified.

If Right$(nodParentNode.FullPath, 1) "\" Then
sPath = nodParentNode.FullPath & "\"
Else: sPath = nodParentNode.FullPath
End If
'strip off the "My Computer" from the FullPath property.

'The actual fullpath is "My Computer\C:\", however,

'the Findxxx APIs want only the qualified path, i.e "C:\".

sPath = Mid$(sPath, 13, Len(sPath))
'find the first file matching the parameter \*.*

hFile = FindFirstFile(sPath & "*.*" & Chr$(0), WFD)

If hFile -1 Then

sFile = TrimNull(WFD.cFileName)

While FindNextFile(hFile, WFD)

sFile = TrimNull(WFD.cFileName)

'ignore the 2 standard root entries

If (sFile ".") And (sFile "..") Then

If (WFD.dwFileAttributes And vbDirectory) Then
'add the item and its icon

Set nodX = tvwTree.Nodes.Add(nodParentNode.Key, _
tvwChild, _
sPath & sFile & "Dir", _
sFile, 8, 9)
End If

End If

Wend

End If

r = FindClose(hFile)

nodParentNode.Sorted = displaySorted
nodParentNode.Expanded = displayExpanded

End Sub

Private Sub Form_Load()
'centre the form

Me.Move (Screen.Width - Me.Width) / 2, (Screen.Height - Me.Height) / 2
'set initial options

chkSort.Value = 1
chkExpanded.Value = 1
optLoadType(0).Value = True
'load the system drives

GetSystemDrives
'store the initial number of treeview elements for

'later subtraction when presenting the total number

'of files loaded (tvwControl_click routine)

NoOfDrives = tvwControl.Nodes.Count
lblMessage = "Set your Load options, then click any drive."
End Sub

Private Sub cmdEnd_Click()
Unload Me
Set Form1 = Nothing

End Sub

Private Sub chkExpanded_Click()
displayExpanded = chkExpanded.Value = 1
End Sub

Private Sub chkSort_Click()
displaySorted = chkSort.Value = 1
End Sub

Private Sub optLoadType_Click(Index As Integer)
LoadAll = optLoadType(1).Value = True
End Sub

Private Sub GetSystemDrives()
Dim nodX As Node
Dim r As Long
Dim allDrives As String
Dim currDrive As String
Dim drvIcon As Integer
'assign the imagelist to the treeview

tvwControl.ImageList = ImageList1
'add a base "My Computer" to the tree

Set nodX = tvwControl.Nodes.Add(, , "Root", "My Computer", 1, 1)
nodX.Expanded = True
'get the list of all available drives

allDrives = rgbGetAvailableDrives()

Do Until allDrives = Chr$(0)

'strip off one drive item from the allDrives$

currDrive = StripNulls(allDrives)

'determine the appropriate imagelist icon to display

drvIcon = GetDriveDisplayIcon(currDrive)

'we can't have the trailing slash, so ..

currDrive = Left$(currDrive, 2)

'Add the drive to the treeview.

Set nodX = tvwControl.Nodes.Add("Root", _
tvwChild, _
currDrive$ & "Dir", _
currDrive$, drvIcon, drvIcon)
nodX.Expanded = True

Loop

'force sorting of the drive letters

nodX.Sorted = True
End Sub

Private Function rgbGetAvailableDrives() As String
'returns a single string of available drive

'letters, each separated by a chr$(0)

Dim r As Long
Dim tmp As String

tmp = Space$(64)
r = GetLogicalDriveStrings(Len(tmp), tmp)

rgbGetAvailableDrives = Trim$(tmp)
End Function

Private Function GetDriveDisplayIcon(driveName) As Integer
Dim dIcon As Integer

Select Case GetDriveType(driveName)
Case 0, 1: dIcon = 1
Case DRIVE_REMOVABLE:
Select Case Left$(driveName, 1)
Case "a", "b": dIcon = 2
Case Else: dIcon = 5
End Select

Case DRIVE_FIXED: dIcon = 3
Case DRIVE_REMOTE: dIcon = 6
Case DRIVE_CDROM: dIcon = 4
Case DRIVE_RAMDISK: dIcon = 7
End Select

GetDriveDisplayIcon = dIcon

End Function

Private Function StripNulls(startstr As String) As String
'Take a string separated by a chr$(0), and split off 1 item, and

'shorten the string so that the next item is ready for removal.

Dim pos As Integer
Dim c As Integer
pos = InStr(startstr$, Chr$(0))

If pos Then
StripNulls = Mid$(startstr, 1, pos - 1)
startstr = Mid$(startstr, pos + 1, Len(startstr))
Exit Function
End If
End Function

Private Sub tvwControl_Click()
Dim nodX As Node
'show a wait message for long searches

lblMessage = "Searching drive " & _
tvwControl.SelectedItem & _
" for folders ... please wait"
DoEvents
'identify the selected node

Set nodX = tvwControl.SelectedItem
'verify it's valid

If (UCase$(Right$(nodX.Key, 3)) = "DIR") And (nodX.Children = 0) Then

'based on the user options, ...

If LoadAll Then
GetAllDrivesFolders tvwControl, nodX
Else: GetNextLevelFolders tvwControl, nodX
End If

End If
'subtract NoOfDrives because "My Computer" and the

'initial drives loaded should not be counted as a folder

lblMessage = "Total folders displayed : " & _
tvwControl.Nodes.Count - NoOfDrives

End Sub

'Please note that if you select Load All Drive's Folders,

'and you have a large drive with many folders, the app may appear to

'hang as it retrieves the information. Therefore, save the project

'before running, in case you need to Ctrl-Alt-Del out of the routine.

Enumerating Folders using FindFirstFile & FindNextFile API, AdvancedRelated
Related page Enumerating Folders using the FindFirstFile & FindNextFile
APIs has been completed.
This code demonstrates how to both recursively and singly search for all
folders on a target drive using the Win95/NT4 APIs FindFirstFile and
FindNextFile, and a routine to search just the selected folder.
The results are displayed in a treeview control, complete with the
appropriate icons for the type of drive installed, and folder icons for
the folders. The search depth (single level or all folders), as well as
options for sorting the folders and expanding on load are user-selectable.
For a discussion on the FindFirstFile, FindNextFile, and the WIN32_FIND_DATA
structure, see Enumerating Folders using FindFirstFile & FindNextFile.
Start a new project, and to the form add a command buttons (cmdEnd), a
Treeview control (tvwControl), an autosizing label (lblMessage), two
checkbox controls (chkExpanded and chkSort), and a control array of 2
option buttons (optLoadType(0) & optLoadType(1)), as indicated in the
illustration.
Add an imagelist to the form (ImageList1), and populate it with several
16x16 pixel icons. If you would prefer, download a blank form containing
the imagelist icons used in this demo rather than construct them yourself.