0

交叉张贴在这里： 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

有任何想法吗？

4

1 回答 1

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
于 2013-05-10T16:41:59.753 回答