0

ここに投稿されたクロス: http://www.vbforums.com/showthread.php?721189-Terminate-Recursive-Directory-Search-using-good-ol-FSO&p=4411543#post4411543

私のオフィスではフォルダが移動するという問題が繰り返し発生しており、フォルダを追跡する簡単な方法が必要です。フォルダーが見つかったら終了する方法がわからないことを除いて、期待どおりに実行される次の関数があります。これは、すべてのインスタンスを検索する再帰的なディレクトリ検索をモデルにしています。問題は、1 つのインスタンスを見つけて終了したいということです。

クラスモジュールを入れたり、イベントや状態モニターにフックしたりせずに、このことを自分自身の呼び出しを停止させることは可能ですか? もしそうなら、どうすればそれを達成できますか？

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 に答える