In a standard Module: 
 
Option Compare Text 
Option Explicit 
 'The following is a function to call the directory browse window
Private Const BIF_RETURNONLYFSDIRS As Long = &H1 
Private Const BIF_DONTGOBELOWDOMAIN As Long = &H2 
Private Const BIF_RETURNFSANCESTORS As Long = &H8 
Private Const BIF_BROWSEFORCOMPUTER As Long = &H1000 
Private Const BIF_BROWSEFORPRINTER As Long = &H2000 
Private Const BIF_BROWSEINCLUDEFILES As Long = &H4000 
Private Const MAX_PATH As Long = 260 
 
Type BrowseInfo 
    hOwner As Long 
    pidlRoot As Long 
    pszDisplayName As String 
    lpszINSTRUCTIONS As String 
    ulFlags As Long 
    lpfn As Long 
    lParam As Long 
    iImage As Long 
End Type 
 
Type SHFILEOPSTRUCT 
    hwnd As Long 
    wFunc As Long 
    pFrom As String 
    pTo As String 
    fFlags As Integer 
    fAnyOperationsAborted As Boolean 
    hNameMappings As Long 
    lpszProgressTitle As String 
End Type 
 
Declare Function SHGetPathFromIDListA Lib "shell32.dll" ( _ 
ByVal pidl As Long, _ 
ByVal pszBuffer As String) As Long 
Declare Function SHBrowseForFolderA Lib "shell32.dll" ( _ 
lpBrowseInfo As BrowseInfo) As Long 
 
Function BrowseFolder(Optional Caption As String = "") As String 
     
    Dim BrowseInfo As BrowseInfo 
    Dim FolderName As String 
    Dim ID As Long 
    Dim Res As Long 
     
    With BrowseInfo 
        .hOwner = 0 
        .pidlRoot = 0 
        .pszDisplayName = String$(MAX_PATH, vbNullChar) 
        .lpszINSTRUCTIONS = Caption 
        .ulFlags = BIF_RETURNONLYFSDIRS 
        .lpfn = 0 
    End With 
    FolderName = String$(MAX_PATH, vbNullChar) 
    ID = SHBrowseForFolderA(BrowseInfo) 
    If ID Then 
        Res = SHGetPathFromIDListA(ID, FolderName) 
        If Res Then 
            BrowseFolder = Left$(FolderName, InStr(FolderName, _ 
            vbNullChar) - 1) 
        End If 
    End If 
     
End Function 
 
Sub listfilesinfoldersandsub() 
    Dim i               As Long 
    Dim Path            As String 
    Dim Prompt          As String 
    Dim Title           As String 
    Dim TempArr() As String 
    With Application.FileSearch 
         
         'Presently using the BrowseFolder function
         'Comment the following code out to use a fixed path
         'or to look in the path where this workbook resides
        Path = BrowseFolder("Select A Folder") 
        If Path = "" Then 
            Exit Sub 
        Else 
            .LookIn = Path 
             'If you comment out the preceding code, uncomment one of the
             'following two lines
             '    .LookIn = "F:\Temp\"
             '    .LookIn = ThisWorkbook.Path 'Change to root path
            .FileType = msoFileTypeAllFiles 
            .SearchSubFolders = True 
            .Execute 
             'If you comment out the path code using the function
             'then you will need to comment the following End If also
        End If 
        For i = 1 To .FoundFiles.Count 
             
            TempArr = Split(.FoundFiles(i), Application.PathSeparator) 
            Range("A" & i).Resize(1, UBound(TempArr) + 1) = TempArr 
             'comment the two lines above and the Dim TempArr() As String at the beginning of sub
             'and uncomment the line below to use this without putting
             'each directory in a seperate cell
             '    Range("A" & i).Value = .FoundFiles(i)
             
        Next i 
    End With 
    Columns.AutoFit 
End Sub