通过子文件夹递归搜索回到根目录

Question

我有一个功能可以搜索给定目录的子文件夹并找到我需要的文件名。但是，它只遍历一组子文件夹，找到第一个，然后遍历到子文件夹的末尾。然而，它随后就停止了。我浏览了各种线程并尝试了不同的选择但没有快乐。

我需要它然后循环回到根目录（比如，sPath=C:\Windows）并查看下一个子文件夹，遍历整个目录，回到根文件夹，依此类推，直到找到所需的文件。我似乎无法让那部分工作，希望这里有人可以帮助指出我所缺少的东西。我试图将此设置保存在更高级别的根文件夹中，而不是必须从目录中的较低位置开始才能使其工作。这是函数：

Function recurse(sPath As String, strname As String, strName3 As String)

Dim FSO As New FileSystemObject
Dim myFolder As Scripting.Folder
Dim mySubFolder As Scripting.Folder
Dim myFile As Scripting.file    

Dim strJDFile As String
Dim strDir As String
Dim strJDName As String

Set myFolder = FSO.GetFolder(sPath)

' strName = Range("a2").Offset(0, 3)
strName3 = Replace(strName3, "/", " ")

For Each mySubFolder In myFolder.SubFolders
Debug.Print " mySubFolder: " & mySubFolder

For Each myFile In mySubFolder.Files        

    If "*" & myFile.Name & "*" Like "*" & strName3 & "*" Then
        strJDName = myFile.Name
        strDir = mySubFolder & "\"
        strJDFile = strDir & strJDName

        recurse = strJDFile

        Exit Function

    Else
        Debug.Print "  myFile.name: " & myFile.Name
    End If

Next

recurse = recurse(mySubFolder.Path, strname, strName3)

Next

End Function

Answer 1

如果您在 Windows 下运行 Excel。

，那么您可以根据自己的使用习惯使用以下例程

使用 Excel 文件夹选择器例程选择基本文件夹
输入文件名掩码（例如：Book1.xls*）
使用Dir命令window命令检查所有文件夹和子文件夹是否有以Book1.xls[=26=开头的文件]
命令的结果被写入一个临时文件（在宏的末尾被删除）
- 有一种方法可以将其直接写入 VBA 变量，但是当我这样做时我发现屏幕闪烁太多。
然后将结果收集到 vba 数组中，并写入工作表，但您可以对结果做任何您想做的事情。

Option Explicit
'set references to
'   Microsoft Scripting Runtime
'   Windows Script Host Object model
Sub FindFile()
    Dim WSH As WshShell, lErrCode As Long
    Dim FSO As FileSystemObject, TS As TextStream
    Dim sTemp As String
    Dim sBasePath As String
    Dim vFiles As Variant, vFullList() As String
    Dim I As Long
    Dim sFileName As String

    sTemp = Environ("Temp") & "\FileList.txt"

'Select base folder
With Application.FileDialog(msoFileDialogFolderPicker)
    .AllowMultiSelect = False
    If .Show = -1 Then 'if OK is pressed
        sBasePath = .SelectedItems(1)
    Else
        Exit Sub
    End If
End With

'File name mask
sFileName = InputBox("Entire File Mask", "File Finder")

Set WSH = New WshShell
lErrCode = WSH.Run("CMD /c dir """ & sBasePath & "\*" & sFileName & """ /A-D /B /S > " & sTemp, xlHidden, True)

If Not lErrCode = 0 Then
    MsgBox "Problem Reading Directory" & _
        vbLf & "Error Code " & lErrCode
    Exit Sub
End If


Set FSO = New FileSystemObject
Set TS = FSO.OpenTextFile(sTemp, ForReading, False, TristateFalse)

vFiles = Split(TS.ReadAll, vbLf)
TS.Close
FSO.DeleteFile sTemp
Set FSO = Nothing
Set WSH = Nothing

ReDim vFullList(1 To UBound(vFiles), 1 To 1)
For I = 1 To UBound(vFiles)
    vFullList(I, 1) = vFiles(I)
Next I

Dim rDest As Range
Set rDest = Cells(1, 2).Resize(UBound(vFullList, 1), UBound(vFullList, 2))

With rDest
    .EntireColumn.Clear
    .Value = vFullList
    .EntireColumn.AutoFit
End With

End Sub

通过子文件夹递归搜索回到根目录

Recursive Search Through Subfolders BACK to Root Directory

excel

recursion

vba

subdirectory