获取目录文件夹名称和只有Upto 2子文件夹名称

我想从目录中获取文件夹的名称，并从该目录中获取任何子文件夹的名称。

所以它是主目录 – >文件夹名称 – > SubFolder1 – > SubFolder2

下面的代码获取所有的文件夹和子文件夹名称。我从这里得到的代码。 任何想法我怎么能限制只有两个子文件夹？

Option Explicit Sub FolderNames() Application.ScreenUpdating = False Dim xPath As String Dim xWs As Worksheet Dim fso As Object, j As Long, folder1 As Object With Application.FileDialog(msoFileDialogFolderPicker) .Title = "Choose the folder" .Show End With On Error Resume Next xPath = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1) & "\" Application.Workbooks.Add Set xWs = Application.ActiveSheet xWs.Cells(1, 1).Value = xPath xWs.Cells(2, 1).Resize(1, 5).Value = Array("Path", "Dir", "Name", "Date Created", "Date Last Modified") Set fso = CreateObject("Scripting.FileSystemObject") Set folder1 = fso.getFolder(xPath) getSubFolder folder1 xWs.Cells(2, 1).Resize(1, 5).Interior.Color = 65535 xWs.Cells(2, 1).Resize(1, 5).EntireColumn.AutoFit Application.ScreenUpdating = True End Sub Sub getSubFolder(ByRef prntfld As Object) Dim SubFolder As Object Dim subfld As Object Dim xRow As Long For Each SubFolder In prntfld.SubFolders xRow = Range("A1").End(xlDown).Row + 1 Cells(xRow, 1).Resize(1, 5).Value = Array(SubFolder.Path, Left(SubFolder.Path, InStrRev(SubFolder.Path, "\")), SubFolder.Name, SubFolder.DateCreated, SubFolder.DateLastModified) Next SubFolder For Each subfld In prntfld.SubFolders getSubFolder subfld Next subfld End Sub 

Answer 1

getSubFolder实现有点奇怪…但你可以简单地添加第二个参数 – 我们称之为Level为整数。 当从主目录调用过程时，可以将其设置为0.在过程中的recursiv调用中，在传递过程中始终添加1。 所以你总是知道你在哪个层次

 Sub getSubFolder(ByRef prntfld As Object, ByVal Level As Integer) Dim SubFolder As Object Dim subfld As Object Dim xRow As Long Level = Level + 1 If Level >= 3 Then Exit Sub For Each SubFolder In prntfld.SubFolders xRow = Range("A1").End(xlDown).Row + 1 Cells(xRow, 1).Resize(1, 5).Value = Array(SubFolder.Path, Left(SubFolder.Path, InStrRev(SubFolder.Path, "\")), SubFolder.Name, SubFolder.DateCreated, SubFolder.DateLastModified) getSubFolder SubFolder, Level Next SubFolder End Sub 

没有testing，但应该工作。

这里循环中的If语句的代码相同：

 Sub getSubFolder(ByRef prntfld As Object, ByVal Level As Integer) Dim SubFolder As Object Dim subfld As Object Dim xRow As Long Level = Level + 1 For Each SubFolder In prntfld.SubFolders xRow = Range("A1").End(xlDown).Row + 1 Cells(xRow, 1).Resize(1, 5).Value = Array(SubFolder.Path, Left(SubFolder.Path, InStrRev(SubFolder.Path, "\")), SubFolder.Name, SubFolder.DateCreated, SubFolder.DateLastModified) If Level <= 2 Then getSubFolder SubFolder, Level Next SubFolder End Sub 

结果应该是一样的。

Answer 2

我遇到了一个类似的问题，我想通过使用FolderExists函数获取我想要的文件夹后，停止循环其他子文件夹。 但是，因为我用一个For循环来遍历FileSystemObject的子文件夹，而且由于VBA不允许你像For循环一样离开For循环，所以我在返回所需的子文件夹后使用了Exit Sub语句，使用= retval语句格式。