Get dir Folder Name and Only Upto 2 Subfolders Name - vba

Question

I want to get Names of Folders from a Directory and Names of Any Subfolders from that Directory Upto 2 Levels.
So It's Main Dir -> Folder Name -> SubFolder1 -> SubFolder2
The code below gets all the Folders and Subfolders Name.I got the code from here . Any idea how can I limit to just two subfolders only ?
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 is implemented a little bit strange ... but you can simply add a second parameter - let's call it Level as integer to it. When calling the procedure from the Main Dir you can set it to 0. In the recursiv call within the procedure you add always 1 to it before you pass it. So you know always at which level you are
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
haven't tested, but should work.
here the same code with the If statement inside the loop:
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
The result should be the same.

Answer 2

I came across a similar issue whereby I wanted to stop looping through other subfolder once I got the folder I wanted using the FolderExists function. However as I used a For loop to loop through subfolders of FileSystemObject and as VBA does not allow you to get out of the For loop like you do to a While loop, I used Exit Sub statement after returning the desired sub folder by using the = retval statement format.