通过子文件夹进行递归搜索返回到根目录 [英] Recursive Search Through Subfolders BACK to Root Directory

问题描述

我有一个功能，可以搜索给定目录的子文件夹并找到我需要的文件名.但是，它仅经过一组子文件夹，找到第一个子文件夹，然后到达子文件夹的末尾.但是，它只是停止了.我浏览了各种线程，尝试了不同的选择，但没有喜悦.

I have a function that works to search through the subfolders of a given directory and finds the file name I need. However, it only goes through one set of subfolders, finding the first one and then going through to the end of the subfolders. However, it then just stops. I have looked through various threads and tried different options but no joy.

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

I need it to then loop back to the root directory (say, sPath=C:\Windows) and look at the next subfolder, go through that whole directory, come back to the root folder, and so on until it finds the file it needs. I cannot seem to get that part to work, hoping someone here can help point out what I am missing. I am trying to keep this set at a higher level root folder rather than have to start lower in in the directory to get it to work. Here is the function:

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

推荐答案

如果您是在Windows下运行Excel，那么这里的例程可以适应您的使用.

Here is a routine you may be able to adapt to your use, if you are running Excel under Windows.

• 使用Excel文件夹选择器例程选择基本文件夹
• 输入文件名掩码(例如:Book1.xls*)
• 使用Dir命令窗口命令检查所有文件夹和子文件夹中是否存在以Book1.xls
开头的文件
• 命令的结果被写入一个临时文件(在宏末尾删除)
  • 有一种方法可以将其直接写入VBA变量，但是这样做之后，我会看到太多的屏幕闪烁.
  • Pick a base folder using the Excel folder picker routine
  • Enter a file name mask (eg: Book1.xls*)
  • Uses the Dir command window command to check all the folders and subfolders for files that start with Book1.xls
  • The results of the command are written to a temporary file (which is deleted at the end of the macro)
    • There is a way to write it directly to a VBA variable, but I see too much screen flicker when I've done that.

    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
    

    这篇关于通过子文件夹进行递归搜索返回到根目录的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！