我有一个功能,可以搜索给定目录的子文件夹并找到我需要的文件名。但是,它只经过一组子文件夹,找到第一个子文件夹,然后到达子文件夹的末尾。但是,它只是停止了。我浏览了各种线程,尝试了不同的选择,但没有喜悦。
我需要它然后循环回到根目录(例如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
答案 0 :(得分:1)
如果您在Windows下运行Excel,这是您可以适应您的使用的常规程序。
Book1.xls*
)Dir
命令窗口命令来检查所有文件夹和子文件夹,查找以Book1.xls
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