递归搜索子文件夹返回根目录

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命令窗口命令检查所有文件夹和子文件夹中以Book1.xls开头的文件
• 命令的结果将写入一个临时文件(在宏结束时删除(
  • 有一种方法可以直接将其写入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