Is it possible to list all the files and folders in a custom directory - excel vba

Question

I wanted to know whether any or all of these functions are possible in excel VBA or not:

• List all the folders and sub folders within a local area (path name

Answer 1

You could use CMD too:

Sub MM()

Dim fileResults As Variant

fileResults = GetFiles("C:\Users\Macro Man\Documents")

Range("A1").Resize(UBound(fileResults) + 1, 1).Value = _
    WorksheetFunction.Transpose(fileResults)

End Sub


'// UDF to populate array with files, assign to a Variant variable. 
Function GetFiles(parentFolder As String) As Variant

GetFiles = Filter(Split(CreateObject("WScript.Shell").Exec("CMD /C DIR """ & parentFolder & _
    IIf(Right(parentFolder, 1) = "\", vbNullString, "\") & "*.*"" /S /B /A:-D").StdOut.ReadAll, vbCrLf), ".")

End Function

This is a lot quicker (takes a couple of seconds to do 1000+ files on a moderate spec PC) if you have lots of files as it doesn't need recursion.

Answer 2

This will list all the files in a selected folder (It will promt a dialog box so you can select the folder):

Force the explicit declaration of variables

Option Explicit

Create a function to select the folder where the files are:

        Function ChooseFolder() As String

        'function to select the folder where the files are

        Dim fldr As FileDialog
        Dim sItem As String

        Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
        With fldr
            .Title = "Select a Folder"
            .AllowMultiSelect = False
            If .Show <> -1 Then GoTo NextCode
            sItem = .SelectedItems(1)
        End With

    NextCode:
        ChooseFolder = sItem
        Set fldr = Nothing

    End Function

> Enter the routines to list all files in folder and sub-folders
Sub ListFiles2()

    Range("A:H").Select
    Selection.ClearContents


    'Declare the variables
    Dim objFSO As Scripting.FileSystemObject
    Dim objTopFolder As Scripting.Folder
    Dim strTopFolderName As String, ProjectF As String
    Dim i As Long

    'Insert the headers for Columns A through F
    Range("A1").Value = "File Name"
    Range("B1").Value = "Parent Folder"
    Range("C1").Value = "File Type"
    Range("D1").Value = "Date Created"
    Range("E1").Value = "Date Last Accessed"
    Range("F1").Value = "Date Last Modified"
    Range("G1").Value = "Author"
    Range("H1").Value = "Last Saved by"


    'strTopFolderName = "C:\Users\IGarcia\Documents\QMS\LaBella Engineering"

    'Create an instance of the FileSystemObject
    Set objFSO = CreateObject("Scripting.FileSystemObject")

    'Get the top folder
    Set objTopFolder = objFSO.GetFolder(ChooseFolder)

    'Call the RecursiveFolder routine
    Call RecursiveFolder2(objTopFolder, True)

    'Change the width of the columns to achieve the best fit
    Columns.AutoFit



End Sub




Sub RecursiveFolder2(objFolder As Scripting.Folder, IncludeSubFolders As Boolean)

    'Declare the variables
    Dim objFile As Scripting.File
    Dim objSubFolder As Scripting.Folder
    Dim NextRow As Long

    Dim ws1 As Excel.Worksheet
    Dim ws2 As Excel.Worksheet

    Dim oFolder As Object, oFile As Object, objFile2 As Object

    Set oFolder = CreateObject("Shell.Application").Namespace(objFolder.Path)


    'Find the next available row
    NextRow = Cells(Rows.Count, "C").End(xlUp).Row + 1

    'Loop through each file in the folder
    For Each objFile In objFolder.Files
        Cells(NextRow, "A").Value = objFile.Name
        Cells(NextRow, "B").Value = objFile.ParentFolder
        Cells(NextRow, "C").Value = objFile.Type
        Cells(NextRow, "D").Value = objFile.DateCreated
        Cells(NextRow, "E").Value = objFile.DateLastAccessed
        Cells(NextRow, "F").Value = objFile.DateLastModified

        Set oFile = oFolder.ParseName(objFile.Name)
        Cells(NextRow, "G") = oFolder.GetDetailsOf(oFile, 20)

        Set objFile2 = CreateObject("DSOFile.OleDocumentProperties")
        On Error Resume Next
        objFile2.Open (objFile.Path)
        Cells(NextRow, "H").Value = objFile2.SummaryProperties.LastSavedBy

        NextRow = NextRow + 1

    Next objFile



    'Loop through files in the subfolders
    If IncludeSubFolders Then
        For Each objSubFolder In objFolder.SubFolders
            Call RecursiveFolder2(objSubFolder, True)
        Next objSubFolder
    End If



End Sub

Answer 3

I did a quick example to show you how to list all files and sub folders:

Option Explicit

Private Sub test()
    readFileSystem ("C:\Temp\")
End Sub

Private Sub readFileSystem(ByVal pFolder As String)
    Dim oFSO As Object
    Dim oFolder As Object

    ' create FSO
    Set oFSO = CreateObject("Scripting.FileSystemObject")

    ' get start folder
    Set oFolder = oFSO.getFolder(pFolder)

    ' list folder content
    listFolderContent oFolder

    ' destroy FSO
    Set oFolder = Nothing
    Set oFSO = Nothing
End Sub

Private Sub listFolderContent(ByVal pFolder As Object)
    Dim oFile As Object
    Dim oFolder As Object

    ' go thru all sub folders
    For Each oFolder In pFolder.SubFolders
        Debug.Print oFolder.Path
        ' do the recursion to list sub folder content
        listFolderContent oFolder
    Next

    ' list all files in that directory
    For Each oFile In pFolder.Files
        Debug.Print oFile.Path
    Next

    ' destroy all objects
    Set pFolder = Nothing
    Set oFile = Nothing
    Set oFolder = Nothing
End Sub

Answer 4

Here is an example how to get folders and files lists based on Scripting.FileSystemObject and Scripting.Dictionary ActiveX's, without recursive calls, only Do ... Loop:

Option Explicit

Sub Test()

    Dim strFolder As String
    Dim objFolders As Object
    Dim objFiles As Object
    Dim i As Long
    Dim objItem As Object

    ' target folder
    strFolder = "C:\Test"

    ' loop through all folders and files
    Set objFolders = CreateObject("Scripting.Dictionary")
    Set objFiles = CreateObject("Scripting.Dictionary")
    objFolders(0) = strFolder
    i = 0
    With CreateObject("Scripting.FileSystemObject")
        Do
            With .GetFolder(objFolders(i))
                For Each objItem In .Files
                    objFiles(objFiles.Count) = objItem.Path
                Next
                For Each objItem In .SubFolders
                    objFolders(objFolders.Count) = objItem.Path
                Next
            End With
            i = i + 1
        Loop Until i = objFolders.Count
    End With

    ' results output to the 1st sheet
    With Sheets(1)
        .Select
        .Cells.Delete
        .Range(.Cells(1, 1), .Cells(objFolders.Count, 1)).Value = Application.Transpose(objFolders.Items)
        .Range(.Cells(1, 2), .Cells(objFiles.Count, 2)).Value = Application.Transpose(objFiles.Items)
        .Columns.AutoFit
    End With

End Sub