VB - Directory Tree Scanning Code->

[Peter Swinkels]

EDIT:
I forgot about this post. See this thread for a much newer version of the code below: http://www.vbforums.com/showthread.p...ies&highlight=.

Here is the code for a class module that can scan an entire directory tree. Specify in which directory to start and the program will return the path of all underlying subdirectories using the DirFound event. The code is written in Microsoft Visual Basic 5.0 Professional Edition.

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "DirTree"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False

Option Explicit
Dim Level As Long, SubDirName() As String, SubDirCnt As Long, SubDirNr() As Long

Public Event DirFound(DirPath As String)

Public Sub GetTree(TreeRoot As String)
 If InStr(TreeRoot, ":") Then ChDrive Left$(TreeRoot, 1)
ChDir TreeRoot

ReDim SubDirNr(0) As Long
Level = 0
 Do
  Do
   GetDirectories
    If SubDirCnt = 0 Then Exit Do
   GoToNextDir
  Loop
  Do
   If Level = 0 Then
    If SubDirNr(Level) >= SubDirCnt - 1 Then Exit Sub
   Else
    RaiseEvent DirFound(CurDir$)
    GoToPreviousDir
    GetDirectories
     If SubDirNr(Level) < SubDirCnt - 1 Then
      SubDirNr(Level) = SubDirNr(Level) + 1
      GoToNextDir
      GetDirectories
      Exit Do
     End If
   End If
  Loop
 Loop
End Sub

Private Sub GoToNextDir()
ReDim Preserve SubDirNr(Level) As Long
ChDir SubDirName(SubDirNr(Level))
Level = Level + 1
End Sub

Private Sub GoToPreviousDir()
ChDir ".."
Level = Level - 1
ReDim Preserve SubDirNr(Level) As Long
End Sub

Private Sub GetDirectories()
Dim CurPath As String, SubDirFldr As String

CurPath = CurDir$ + IIf(Right$(CurDir$, 1) = "\", "", "\")
SubDirCnt = 0
SubDirFldr = Dir$(CurPath, 30)
 Do Until SubDirFldr = ""
   If GetAttr(CurPath & SubDirFldr) And 16 Then
    If Not (SubDirFldr = "." Or SubDirFldr = "..") Then
     ReDim Preserve SubDirName(SubDirCnt) As String
     SubDirName(SubDirCnt) = SubDirFldr
     SubDirCnt = SubDirCnt + 1
    End If
   End If
  SubDirFldr = Dir$()
 Loop
End Sub

This program should be useful for searching directories for files, for example. It also demonstrates how other directory structures such as the Windows registry can be scanned.