Need VBA Macro to extract folder names and sub folder name

Hi All,
Please help me by building a VBA code which extracts all folder names and sub folder names in a given path.
Names of the folders and subfolders has to be extracted in a single.

Below is the macro which I have a macro which will extract only Folder names of the Provided path, however i need Subfolder names as well.

Sub FolderList()
Dim iFolder As Long
Dim Sno As Integer
Dim oFSO As Object
Dim oFolder As Object
Dim oFldr As Object

iFolder = 6
Sno = 1
Set oFSO = CreateObject("Scripting.FileSystemobject")
Set oFolder = oFSO.getfolder(Range("I10"))         'here, Range("I10") is the cell where i give path
For Each oFldr In oFolder.subfolders
iFolder = iFolder + 1
Cells(iFolder, "C").Value = Sno
Cells(iFolder, "D").Value = oFldr.Name
End Sub

Please help.