'main procedure
Sub Get_Folder_Structure() 
     
    Dim search_Folder As String 
     
     'add new document
    Documents.Add 
     
    searchFolder = Select_Folder_From_Prompt() 
     
    Selection.TypeText (searchFolder) 
    Selection.TypeParagraph 
     
    If search_Folder <> "EMPTY" Then 
        Call List_subfolder_structure(search_Folder, 1) 
    End If 
     
End Sub 
 
 'File selecting function to pick folder
Function Select_Folder_From_Prompt() _ 
    As String 
     
    Dim fd As FileDialog 
     
    Set fd = Application.FileDialog(msoFileDialogFolderPicker) 
     
    With fd 
        .Title = "Select a folder" 
        .AllowMultiSelect = bMultiSelect 
        .InitialFileName = CONST_MODEL_DIRECTORY 
        .Filters.Clear 
         
         'Use the Show method to display the File Picker dialog box and return the user's action.
         'The user pressed the action button.
        If .Show = -1 Then 
            Select_Folder_From_Prompt = .SelectedItems(1) & "\" 
        Else 
            Select_Folder_From_Prompt = "EMPTY" 
        End If 
    End With 
     
End Function 
 
 'Recursive function that looks at folder structure
Function List_subfolder_structure(FolderPath As String, number_of_levels As Integer) 
     
    Dim number_of_files As Integer 
    Dim file_count As Integer 
    Dim file_name As String 
    Dim level_count As Integer 
    Dim file_Path As String 
     
     'list the names of all files in the specified directory
    number_of_files = 0 
    level_count = 0 
     
    file_name = Dir(FolderPath & "*.*", vbDirectory) 
    Dim fileType As String 
     
     'File loop
    Do While ((file_name) <> "") 
         
         ' See if we should skip this file.
        If ((file_name <> ".") And (file_name <> "..")) Then 
             
             'reset level counters
            level_count = 0 
             
             'Level loop
            Do While (number_of_levels > level_count) 
                Selection.TypeText text:=vbTab 
                level_count = level_count + 1 
            Loop 
             'Level loop
             
            Selection.TypeText (file_name) 
            Selection.TypeParagraph 
             
            fileType = getFileType(FolderPath & file_name) 
             
            If (fileType = "Folder") Then 
                number_of_levels = number_of_levels + 1 
                 
                file_Path = FolderPath & file_name & "\" 
                Call List_subfolder_structure(file_Path, number_of_levels) 
                 
                 'reset levels
                number_of_levels = number_of_levels - 1 
            End If 
             
        End If 
         
        number_of_files = number_of_files + 1 
         
        file_name = Dir(FolderPath & "*.*", vbDirectory) 
         
         'Resetting file loop
        Do While (file_count < number_of_files And file_name <> "") 
            file_name = Dir 
             ' Get the next file by resetting
            file_count = file_count + 1 
        Loop 
         'Resetting file loop
         
         'reset file counter
        file_count = 0 
         
    Loop 
     'File loop
     
End Function 
 
 'Determine if file is a folder
Function getFileType(file As String) As String 
     'The GetAttr will return one or a combination of the following values:
     
     '    VB Constant     Value   Explanation
     '    vbNormal    0   Normal
     '    vbReadOnly  1   Read-only
     '    vbHidden    2   Hidden
     '    vbSystem    4   System file
     '    vbDirectory     16  Directory or folder
     '    vbArchive   32  File has been changed since last backup
     '    vbAlias     64  File name is an alias
     
     'and the bits to get just the vbDirectory flag
    fileAttribute = (GetAttr(file) And vbDirectory) 
     
    If fileAttribute = vbDirectory Then 
        getFileType = "Folder" 
    Else 
        getFileType = "File" 
    End If 
     
End Function