Прекратить Рекурсивный Каталог Поиск с использованием хорошего ола»FSO

Question

Крест размещен здесь: http://www.vbforums.com/showthread.php?721189-Terminate-Recursive-Directory-Search-using-good-ol-FSO&p=4411543#post4411543

У нас есть повторяющиеся проблемы папок получать перемещается в моем офисе, и я хочу простой способ отслеживания их вниз. У меня есть следующая функция, которая выполняется так, как ожидалось, за исключением того, что я не могу понять, как ее завершить, как только папка будет найдена. Он моделируется после рекурсивного поиска в каталоге, который находит ВСЕ экземпляры. Проблема в том, что я хочу найти один экземпляр и завершить работу.

Возможно ли, чтобы эта вещь перестала называть себя, не вставляя модуль класса и не подключаясь к событиям и монитору состояния? Если да, то как я могу это сделать?

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 

Вот пример использования

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 

Любые идеи?

Answer 1

Измените функцию, чтобы просто проверить текущую папку:

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