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

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

我需要的代码也深入到兔子洞更深一层，拿起文件名。 这里是代码：

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。

 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 

只需将文件的整个path传递给函数。 它将返回文件名称。

另一个select是这个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，它会recursion地search这个目录下的所有子文件夹。 要使用此function，您需要以下内容：

 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 = "*.*"这将find每个文件与每个文件扩展名。 希望这有助于多一点。