Question

Cross贴在这里： 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

使用好的'FSO终止递归目录搜索

1 个答案: