"Steven Revell" wrote in message
...
Hi all,
I'm looking for a way to loop through all the directories
on a server and run find files (without subdirectory
searching).
I would like it to run on Excel 97 but Excel 2000 will be
fine.
So my questions is does anyone know how to run through all
the subdirectories within a directory. And, if those
directories have sub directories then go through them as
well.
thanks for any help,
Steven
You need to write a recursive function that starts out at some
point does a dir call and lists the files required and calls itself when
it encounters a subdir
Below is an example in
VB
Function GetRecursiveFileList(Startpoint As String, FileExtension As String,
filelist() As String, FileCount As Long) As Long
' ----------------------------------------
' Routine scans filesystem recursively for
' files with specified extension
' ----------------------------------------
Dim file_name As String
Dim FIndent As Integer, FIndex As Integer
Dim File_Path As String, StrtPath As String
Dim File_Read As Integer
Dim x As Boolean, xTemp As Integer, S$
Dim i As Integer, ierr As Long
On Error Resume Next
FIndent = FIndent + 1
If Right(Startpoint, 1) < "\" Then
File_Path = Startpoint & "\"
Else
File_Path = Startpoint
End If
file_name = Dir$(File_Path, vbDirectory + vbReadOnly + vbArchive)
File_Read = 1
Dim FileNameToAdd As String
Dim IsDirectory As Boolean
x = False
Const CustomTabs = vbTab
File_Read = 1
Do While file_name < ""
If file_name < "." And file_name < ".." Then
IsDirectory = (GetAttr(File_Path & file_name) = vbDirectory) Or
(GetAttr(File_Path & file_name) = vbDirectory + vbArchive) _
Or (GetAttr(File_Path & file_name) = vbDirectory + vbReadOnly) _
Or (GetAttr(File_Path & file_name) = vbDirectory + vbReadOnly +
vbArchive)
FileNameToAdd = ""
'Check for file types
If IsDirectory = False Then
If UCase(Right(file_name, Len(file_name) - InStr(file_name,
"."))) = UCase(FileExtension) Then
FileNameToAdd = File_Path & file_name
End If
If FileNameToAdd < "" Then
filelist(FileCount) = FileNameToAdd
FileCount = FileCount + 1
End If
Else
If IsDirectory Then 'Perform recursive
'MsgBox "Searching directory :" & File_Path & file_name
StrtPath = File_Path & file_name
ierr = GetRecursiveFileList(StrtPath, FileExtension,
filelist(), FileCount)
End If
End If
x = True
' FIndex = FIndex + 1
End If
If x Then
file_name = Dir$(File_Path, vbDirectory + vbArchive +
vbReadOnly)
For i = 2 To File_Read
file_name = Dir$
Next i
x = False
End If
file_name = Dir$
If file_name = "" Then
file_name = Dir$(, vbReadOnly)
End If
File_Read = File_Read + 1
Loop
FIndent = FIndent - 1
End Function
Keith