Question

我有一个代码，它将完整列出给定路径中所有文件夹和子文件夹的全部内容。我愚蠢地在包含数万个子文件夹的文件夹上运行代码，所以当我等待完成时，我想开始考虑下一步。

我需要代码进一步深入兔子洞并拿起文件名。这是代码：

Option Explicit 

    Dim i As Long, j As Long 
    Dim searchfolders As Variant 
    Dim FileSystemObject 

    Sub ListOfFolders() 
        Dim LookInTheFolder As String 

        i = 1 
        LookInTheFolder = "C:\" ' As you know; you should modificate this row.
        Set FileSystemObject = CreateObject("Scripting.FileSystemObject") 
        For Each searchfolders In FileSystemObject.GetFolder(LookInTheFolder).SubFolders 
            Cells(i, 1) = searchfolders 
            i = i + 1 
            SearchWithin searchfolders 
        Next searchfolders 

    End Sub 

Sub SearchWithin(searchfolders) 
        On Error GoTo exits 
    For Each searchfolders In FileSystemObject.GetFolder(searchfolders).SubFolders 
        j = UBound(Split(searchfolders, "\")) 
        Cells(i, j) = searchfolders 
        i = i + 1 
        SearchWithin searchfolders 
        Next searchfolders 
        exits: 
End Sub

代码输出到树状图表中，我想扩展到最后一个分支，包括文件名。

请帮忙！谢谢。

Answer 1

我不得不多次这样做，而且很多次我使用了同样的功能。

Function GetFilenameFromPath(ByVal strPath As String) As String
' Returns the rightmost characters of a string upto but not including the rightmost '\'

    If Right$(strPath, 1) <> "\" And Len(strPath) > 0 Then
        GetFilenameFromPath = GetFilenameFromPath(Left$(strPath, Len(strPath) - 1)) + Right$(strPath, 1)
    End If
End Function

只需将文件的整个路径传递给函数即可。它将返回文件名。

另一种选择是这个功能。

Public Function RecursiveDir(colFiles As Collection, _
                          ByVal strFolder As String, _
                          strFileSpec As String, _
                          bIncludeSubfolders As Boolean)

 Dim strTemp As String
 Dim colFolders As New Collection
 Dim vFolderName As Variant

'Add files in strFolder matching strFileSpec to colFiles
 strFolder = TrailingSlash(strFolder)
 strTemp = Dir(strFolder & strFileSpec)
 Do While strTemp <> vbNullString
     colFiles.Add strFolder & strTemp
     strTemp = Dir
 Loop

'Fill colFolders with list of subdirectories of strFolder
 If bIncludeSubfolders Then
     strTemp = Dir(strFolder, vbDirectory)
     Do While strTemp <> vbNullString
         If (strTemp <> ".") And (strTemp <> "..") Then
             If (GetAttr(strFolder & strTemp) And vbDirectory) <> 0 Then
                 colFolders.Add strTemp
             End If
         End If
         strTemp = Dir
     Loop

'Call RecursiveDir for each subfolder in colFolders
     For Each vFolderName In colFolders
         Call RecursiveDir(colFiles, strFolder & vFolderName, strFileSpec, True)
     Next vFolderName
 End If

'Garbage collection
 Set colFolders = Nothing

End Function

此函数将填充给定目录中每个文件名的集合。如果需要，可以将bIncludeSubfolders设置为true，它将递归搜索此目录中的所有子文件夹。要使用此功能，您需要以下内容：

Dim colFiles As New Collection ' The collection of files
Dim Path As String ' The parent Directory you want to search
Dim subFold As Boolean ' Search sub folders, yes or no?
Dim FileExt As String ' File extension type to search for

然后设置FileExt = "*.*"哪个文件会找到每个文件扩展名的文件。希望这会有所帮助。

修改列出文件夹/子文件夹以包含文件名的现有代码

1 个答案: