none
Make a Spreadsheet or table from folders RRS feed

  • Question

  • I would like to write a list of all folders at the end of a path into a spreadsheet in excel or a table in access.  I wish to create a vba module (in Access2007) to create a spreadsheet or append to a table in a database.

    JR

    Wednesday, March 14, 2012 10:28 PM

Answers

  • Well below a nice way, using the FileDialog to choose your startfolder, and then list all the FolderNames into your sheet:

    Option Explicit
    Sub GetFolderNames()
         
        ' source:
        ' http://www.mrexcel.com/forum/showthread.php?p=2053869#2
        Dim xRow&, vSF
        Dim xDirect$, InitialFoldr$
         
        InitialFoldr$ = "C:\" '<<< Startup folder to begin searching from
         
        With Application.FileDialog(msoFileDialogFolderPicker)
            .InitialFileName = Application.DefaultFilePath & "\"
            .Title = "Please select a folder to list Files from"
            .InitialFileName = InitialFoldr$
            .Show
            If .SelectedItems.Count <> 0 Then
                xDirect$ = .SelectedItems(1) & "\"
            End If
        End With
        
        If xDirect$ <> "" Then
            With CreateObject("Scripting.FileSystemObject").GetFolder(xDirect$)
                For Each vSF In .subfolders
                    ActiveCell.Offset(xRow) = vSF.Name
                    xRow = xRow + 1
                Next vSF
            End With
        End If
    End Sub

    In Access you do something similar, but you will need to change the code a little:

    Private Sub Command4_Click()
    
    Dim rst As DAO.Recordset
    Dim fDialog As Object
    Dim xDirect$, InitialFoldr$
    
    Set rst = CurrentDb.OpenRecordset("Select FolderName From tblFolders")
    
    InitialFoldr$ = "C:\" '<<< Startup folder to begin searching from
     
    Set fDialog = Application.FileDialog(4)
     
    With fDialog
            .AllowMultiSelect = False
            .Title = "Please select a folder to list Files from"
            .InitialFileName = InitialFoldr$
            .Show
            If .SelectedItems.Count <> 0 Then
                xDirect$ = .SelectedItems(1) & "\"
            End If
        End With
         
        If xDirect$ <> "" Then
            With CreateObject("Scripting.FileSystemObject").GetFolder(xDirect$)
                For Each vSF In .subfolders
                 rst.AddNew
                      rst(0).Value = vSF.Name
                    rst.Update
                  Next vSF
            End With
        End If
    
    rst.Close
    
    Set rst = Nothing
    Set fDialog = Nothing
    
    
    End Sub

    Hope this helps,


    Daniel van den Berg | Washington, USA | "Anticipate the difficult by managing the easy"

    Please vote an answer helpful if they helped. Please mark an answer as an answer when your question is being answered.

    Thursday, March 15, 2012 2:58 AM
    Moderator