DirTree




Option Explicit
Option Base 1

Public Sub TraverseTree()
Dim strParentDir As String
Dim strSubDirs() As String
Dim strFullPath As String
Dim strCurFile As String
Dim bFirstFile As Boolean
Dim bEndOfSearch As Boolean
Dim bIsFile As Boolean
Dim lngSubIdx As Long
'*********************************

'Temp vars for demo purposes only

'*********************************

Dim lngFileCount As Long
'*********************************

lngSubIdx = 1
ReDim strSubDirs(1)
'Set the initial directory...

strSubDirs(1) = "C:\"
bEndOfSearch = False
bFirstFile = True

Do While Not bEndOfSearch
strParentDir = strSubDirs(lngSubIdx)
If bFirstFile Then
ChDir strParentDir
strCurFile = Dir(strParentDir, vbArchive Or _
vbDirectory Or vbHidden Or vbNormal Or _
vbReadOnly Or vbSystem)
If strCurFile <> "" And strCurFile <> "." And _
strCurFile <> ".." Then
If GetAttr(strParentDir & strCurFile) = vbDirectory Then
'This is a directory...

ReDim Preserve strSubDirs(UBound(strSubDirs) + 1)
strSubDirs(UBound(strSubDirs)) = strParentDir & _
strCurFile & "\"
Else
'This is a file...

bIsFile = True
End If
End If
bFirstFile = False
Else
strCurFile = Dir(, vbArchive Or vbDirectory Or _
vbHidden Or vbNormal Or vbReadOnly Or vbSystem)
If strCurFile <> "" And strCurFile <> "." And _
strCurFile <> ".." Then
If GetAttr(strParentDir & strCurFile) = vbDirectory Then
'This is a directory...

ReDim Preserve strSubDirs(UBound(strSubDirs) + 1)
strSubDirs(UBound(strSubDirs)) = strParentDir & _
strCurFile & "\"
Else
'This is a file

bIsFile = True
End If
End If
End If

If bIsFile Then
'**************************************************

'This is where you put the code to handle a file...

'Replace this with your code.

'***************************************************

lngFileCount = lngFileCount + 1
'**************************************************

bIsFile = False
Else
'**************************************************

'This is where you put the code to handle all other

'items found...

'**************************************************

End If

If strCurFile = "" Then
lngSubIdx = lngSubIdx + 1
If lngSubIdx > UBound(strSubDirs) Then
bEndOfSearch = True
Else
bFirstFile = True
End If
End If

DoEvents
Loop

MsgBox "Files found: " & lngFileCount

End Sub










( dirtree.html )- by Paolo Puglisi - Modifica del 17/12/2023