Recursive procedure

[Jac Tremblay]

Hi,
I found a lot of information on that subject but I cannot get my own
procedure to work. The code is below.
I'm trying to list all the folder names and their subfolder names with a
recursive procedure. I have done that kind of job before, but i can't get
this one to work properly. I have other versions that work fine but I want to
debug this one. Can someone tell me what's wrong with it, please?
Here is the code:
' ***********************************************************
Option Explicit
Dim strPath As String
Dim fso As Object
Dim oDir As Object
Dim oDir2 As Object
Dim fsoSub As Object
Dim fSubDir As Object
Dim fSubDir2 As Object

' ***********************************************************
Sub CallingProc()
strPath = "C:\Test"
Set fso = CreateObject("Scripting.FileSystemObject")
Set oDir = fso.GetFolder(strPath)
For Each fSubDir In oDir.SubFolders
PrintFolderName strPath
Next fSubDir

Set fso = Nothing
Set fsoSub = Nothing
Set oDir = Nothing
Set oDir2 = Nothing
End Sub

' ***********************************************************
Sub PrintFolderName(strPath As String)
' Supposed to be recursive...
' Print the folder name.
Debug.Print fSubDir.Name
Set fsoSub = CreateObject("Scripting.FileSystemObject")
Set oDir2 = fsoSub.GetFolder(strPath & "\" & fSubDir.Name)
' Check subfolders recursively.
For Each fSubDir2 In oDir2.SubFolders
PrintFolderName strPath
Next fSubDir2
End Sub
' ***********************************************************
Thanks in advance.

 

[Jim Thomlinson]

Give this a whirl... The sub takes the directory you want to seach, then the
range where you want to write the results followed by (optional) the file
extension you are looking for, followed by (optional) whether you want to
search sub directories or not...

Option Explicit
Option Compare Text

Sub test()
Call ListFiles("C:\Test", Sheet1.Range("A2"), "xls", True)
End Sub

Public Sub ListFiles(ByVal strPath As String, _
ByVal rngDestination As Range, Optional ByVal strFileType As String = "*", _
Optional ByVal blnSubDirectories As Boolean = False)
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim strName As String

'Specify the file to look for...
strName = "*." & strFileType
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(strPath)

For Each objFile In objFolder.Files
If objFile.Name Like strName Then
rngDestination.Value = objFile.Path
rngDestination.Offset(0, 1).Value = objFile.DateLastAccessed
Set rngDestination = rngDestination.Offset(1, 0)
End If
Next 'objFile
Set objFile = Nothing

'Call recursive function
If blnSubDirectories = True Then _
DoTheSubFolders objFolder.SubFolders, rngDestination, strName

Set objFSO = Nothing
Set objFolder = Nothing
End Sub


Function DoTheSubFolders(ByRef objFolders As Object, _
ByRef rng As Range, ByRef strTitle As String)
Dim scrFolder As Object
Dim scrFile As Object
Dim lngCnt As Long

On Error GoTo ErrorHandler
For Each scrFolder In objFolders
For Each scrFile In scrFolder.Files
If scrFile.Name Like strTitle Then
rng.Value = scrFile.Path
rng.Offset(0, 1).Value = scrFile.DateLastAccessed
Set rng = rng.Offset(1, 0)
End If
Next 'scrFile

'If there are more sub folders then go back and run function again.
If scrFolder.SubFolders.Count > 0 Then
DoTheSubFolders scrFolder.SubFolders, rng, strTitle
End If
ErrorHandler:
Next 'scrFolder

Set scrFile = Nothing
Set scrFolder = Nothing
End Function
'-------------------

 

[Bob Phillips]

Option Explicit

Dim strPath As String
Dim fso As Object
Dim oDir As Object
Dim fSubDir As Object

' ***********************************************************
Sub CallingProc()
strPath = "C:\myTest"
Set fso = CreateObject("Scripting.FileSystemObject")
Set oDir = fso.getfolder(strPath)
PrintFolderName oDir

Set fso = Nothing
Set oDir = Nothing
End Sub

' ***********************************************************
Sub PrintFolderName(Dir As Object)
' Supposed to be recursive...
' Print the folder name.
Debug.Print Dir.Name
' Check subfolders recursively.
For Each fSubDir In Dir.SubFolders
PrintFolderName fSubDir
Next fSubDir
End Sub



--
HTH

Bob Phillips

(replace somewhere in email address with gmail if mailing direct)

 

[Jac Tremblay]

Thank you very much Bob, I really appreciate. I think that I was tyying to
make things complicated for nothing. You make my day.

 

[Jac Tremblay]

Hi Tom,
Your code lists the files in the folders, not the folders. I actually
started from your code to write my example but could not find the right way
to do it.
Thanks anyway, I take note of you suggestion.

 

[Jim Thomlinson]

No explanation needed. I prefer Bob's code to what I posted. The code I
posted is some that I was given a long time ago and truth be told I never
looked looked back. Perhaps I should grab Bob's code at this point... Thanks
Bob...