Terminate récursive Répertoire Recherche par good ol » OFS

Question

Cross publié ici: http://www.vbforums.com/showthread.php?721189-Terminate-Recursive-Directory-Search-using-good-ol-FSO&p=4411543#post4411543

Nous avons un problème récurrent de dossiers se déplacer autour de mon bureau, et je veux une méthode simple de les traquer. J'ai la fonction suivante qui fonctionne comme prévu, sauf que je ne peux pas comprendre comment l'obtenir pour se terminer une fois le dossier est trouvé. Il est modélisé après une recherche d'annuaire récursive, qui trouve toutes les instances. Le problème est que je veux trouver une instance et terminer.

Est-il possible de faire en sorte que cette machine cesse de s'appeler elle-même sans mettre un module de classe et se connecter à des événements et à un moniteur d'état? Si oui, comment puis-je accomplir cela?

Function FindFolder(CurrentDirectory As Scripting.Folder, FolderName As String) As Scripting.Folder 

On Error GoTo errHandler 

Dim fold As Scripting.Folder 

If CurrentDirectory.SubFolders.Count > 0 Then 
For Each fold In CurrentDirectory.SubFolders 
    Debug.Print fold.Path 
    If fold.Name = FolderName Then 
     Set FindFolder = fold: Exit Function 
    Else 
     Set FindFolder = FindFolder(fold, FolderName) 
    End If 
Next fold 
End If 


Exit Function 

errHandler: 

If Err.Number = 70 Then Resume Next 'Dont have permission to check this directory 

End Function 

Voici un exemple de l'utilisation

Sub FindEm() 

Dim FSO As Scripting.FileSystemObject 
Set FSO = New Scripting.FileSystemObject 

Dim startFold As Scripting.Folder 
Set startFold = FSO.GetFolder("C:\") 

Dim searchFold As Scripting.Folder 
Set searchFold = FindFolder(startFold, "SomeExactFolderName") 

Debug.Print searchFold.Path 


End Sub 

Toutes les idées?

Answer 1

Modifier votre fonction pour tester tout le dossier en cours:

Function FindFolder(CurrentDirectory As Scripting.Folder, FolderName As String) As Scripting.Folder 

On Error GoTo errHandler 

If CurrentDirectory .Name = FolderName Then _ 
    Set FindFolder = CurrentDirectory : Exit Function 

Set FindFolder = Nothing 

Dim fold As Scripting.Folder 

If CurrentDirectory.SubFolders.Count > 0 Then 
For Each fold In CurrentDirectory.SubFolders 
    Debug.Print fold.Path 
    Set FindFolder = FindFolder(fold, FolderName) 
    If not(FindFolder Is Nothing) Then 
     Exit For ' this one 
    End If 
Next fold 
End If