Results 1 to 4 of 4

Thread: List Files In Folder & Subfolders Using DIR

  1. #1
    Junior Member
    Join Date
    Dec 2015
    Posts
    3
    Rep Power
    0

    List Files In Folder & Subfolders Using DIR

    I have posted this question here,

    vba - List all files in a folder and subfolders in excel - Stack Overflow

    http://www.mrexcel.com/forum/excel-q...using-dir.html

    This forum has also many related queries as in below links
    List folders, subfolders and files using macro

    Directory Listing in a Spreadsheet

    This forum has also many posts with similar questions.
    eg - http://www.excelfox.com/forum/f13/se...-files-vba-86/
    http://www.excelfox.com/forum/f2/lis...nd-color-1773/

    Code:
    Sub ListFiles() 
         'Set a reference to Microsoft Scripting Runtime by using
         'Tools > References in the Visual Basic Editor (Alt+F11)
         
         
         'Declare the variables
        Dim objFSO As Scripting.FileSystemObject 
        Dim objTopFolder As Scripting.Folder 
        Dim strTopFolderName As String 
        Dim n As Long 
        Dim Msg As Byte 
        Dim Drilldown As Boolean 
         
         
         
         
         'Assign the top folder to a variable
        With Application.FileDialog(msoFileDialogFolderPicker) 
            .AllowMultiSelect = False 
            .Title = "Pick a folder" 
            .Show 
            If .SelectedItems.Count = 0 Then MsgBox "Operation Cancelled by the user",     vbExclamation + vbOKOnly, "List Files": Exit Sub 
            strTopFolderName = .SelectedItems(1) 
             
             
            Msg = MsgBox("Do you want to list all files in descendant folders,  too?", _ 
            vbInformation + vbYesNo, "Drill-Down") 
            If Msg = vbYes Then Drilldown = True Else Drilldown = False 
        End With 
         
         
         ' create a new sheet
        If Len(Mid$(strTopFolderName, InStrRev(strTopFolderName, "\") + 1)) < 31    Then 
            ThisWorkbook.Sheets.Add(After:=Sheets(Sheets.Count)).Name =    Mid$(strTopFolderName, InStrRev(strTopFolderName, "\") + 1) 
        Else: ThisWorkbook.Sheets.Add(After:=Sheets(Sheets.Count)).Name =   Left(Mid$(strTopFolderName, InStrRev(strTopFolderName, "\") + 1), 31) 
        End If 
         'Insert the headers for Columns A through F
        Range("A1").Value = "File Name" 
        Range("B1").Value = "Ext" 
        Range("C1").Value = "File Name" 
        Range("D1").Value = "File Size" 
        Range("E1").Value = "File Type" 
        Range("F1").Value = "Date Created" 
        Range("G1").Value = "Date Last Accessed" 
        Range("H1").Value = "Date Last Modified" 
        Range("I1").Value = "File Path" 
         
         
         
         
         'Create an instance of the FileSystemObject
        Set objFSO = CreateObject("Scripting.FileSystemObject") 
         
         
         'Get the top folder
        Set objTopFolder = objFSO.GetFolder(strTopFolderName) 
         
         
         'Call the RecursiveFolder routine
        Call RecursiveFolder(objTopFolder, Drilldown) 
         
         
         'Change the width of the columns to achieve the best fit
         'Columns.AutoFit
         
         
         'ActiveSheet.ListObjects.Add(xlSrcRange, Range("A1").CurrentRegion, , xlYes).TableStyle = "TableStyleLight1"
        MsgBox ("Done") 
        ActiveWorkbook.Save 
        Sheet1.Activate 
    End Sub 
     
     
    Sub RecursiveFolder(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 strTopFolderName As String 
        Dim n As Long 
        Dim maxRows As Long 
        Dim sheetNumber As Integer 
        maxRows = 1048576 
         
         
         'Find the next available row
        NextRow = Cells(Rows.Count, "A").End(xlUp).Row + 1 
         
         
         'Loop through each file in the folder
        For Each objFile In objFolder.Files 
             'to take complete filename in column C  and extract filename without  extension lso allowing for fullstops in filename itself
            Cells(NextRow, "A") =    "=LEFT(RC[+2],FIND(""#"",SUBSTITUTE(RC[+2],""."",""#"",LEN(RC[+2])- LEN(SUBSTITUTE(RC[+2],""."",""""))))-1)" 
             
             
             
             
             'to take complete filename from row C and show only its extension
            Cells(NextRow, "B") = "=TRIM(RIGHT(SUBSTITUTE(RC[+1],""."",REPT(""  "",LEN(RC[+1]))),LEN(RC[+1])))" 
             
             
             
             
            Cells(NextRow, "C").Value = objFile.Name 
            Cells(NextRow, "D").Value = Format((objFile.Size / 1024), "000") & " KB" 
            Cells(NextRow, "E").Value = objFile.Type 
            Cells(NextRow, "F").Value = objFile.DateCreated 
            Cells(NextRow, "G").Value = objFile.DateLastAccessed 
            Cells(NextRow, "H").Value = objFile.DateLastModified 
            Cells(NextRow, "I").Value = objFile.Path 
             
             
             
             
             
             
            NextRow = NextRow + 1 
        Next objFile 
         
         
         ' If "descendant" folders also get their files listed, then sub calls itself recursively
         
         
        If IncludeSubFolders Then 
            For Each objSubFolder In objFolder.SubFolders 
                Call RecursiveFolder(objSubFolder, True) 
            Next objSubFolder 
        End If 
         
         
         'Loop through files in the subfolders
         
         
         'If IncludeSubFolders Then
         '   For Each objSubFolder In objFolder.SubFolders
         '  If Msg = vbYes Then Drilldown = True Else Drilldown = False
         '     Call RecursiveFolder(objSubFolder, True)
         'Next objSubFolder
         'End If
         
         
        If n = maxRows Then 
            sheetNumber = sheetNumber + 1 
            ActiveWorkbook.Sheets.Add After:=Worksheets(Worksheets.Count) 
             'ActiveSheet.Name = "Sheet-" & sheetNumber
            ActiveSheet.Name = strTopFolderName & "_" & sheetNumber 
            n = 0 
        End If 
        n = n + 1 
    End Sub
    Code:
    Sub ListFiles() 
        Const sRoot     As String = "C:\" 
        Dim t As Date 
         
         
        Application.ScreenUpdating = False 
        With Columns("A:C") 
            .ClearContents 
            .Rows(1).Value = Split("File,Date,Size", ",") 
        End With 
         
         
        t = Timer 
        NoCursing sRoot 
        Columns.AutoFit 
        Application.ScreenUpdating = True 
        MsgBox Format(Timer - t, "0.0s") 
    End Sub 
     
     
    Sub NoCursing(ByVal sPath As String) 
        Const iAttr     As Long = vbNormal + vbReadOnly + _ 
        vbHidden + vbSystem + _ 
        vbDirectory 
        Dim col         As Collection 
        Dim iRow        As Long 
        Dim jAttr       As Long 
        Dim sFile       As String 
        Dim sName       As String 
         
         
        If Right(sPath, 1) <> "\" Then sPath = sPath & "\" 
         
         
        Set col = New Collection 
        col.Add sPath 
         
         
        iRow = 1 
         
         
        Do While col.Count 
            sPath = col(1) 
             
             
            sFile = Dir(sPath, iAttr) 
             
             
            Do While Len(sFile) 
                sName = sPath & sFile 
                 
                 
                On Error Resume Next 
                jAttr = GetAttr(sName) 
                If Err.Number Then 
                    Debug.Print sName 
                    Err.Clear 
                     
                     
                Else 
                    If jAttr And vbDirectory Then 
                        If Right(sName, 1) <> "." Then col.Add sName & "\" 
                    Else 
                        iRow = iRow + 1 
                        If (iRow And &H3FF) = 0 Then Debug.Print iRow 
                        Rows(iRow).Range("A1:C1").Value = Array(sName, _ 
                        FileLen(sName), _ 
                        FileDateTime(sName)) 
                    End If 
                End If 
                sFile = Dir() 
            Loop 
            col.Remove 1 
        Loop 
    End Sub
    I am using the above 1st code to list the files in server. It is slower compared to 2nd code which uses DIR. Now, I want to modify the 2nd code to give attributes "FileName (as Formula), Ext (as Formula), Date Created, Date Last Accessed, Date Last Modified" as in the 1st code. Also If the list exceeds the row limit, another sheet with folder name-2 should be created and files are listed where they end in previous sheet.

    I want to get the results as outlined below.
    File Name Ext File Name File Size File Type Date Created Date Last Accessed Date Last Modified File Path
    =LEFT(C2,FIND("#",SUBSTITUTE(C2,".","#",LEN(C2)-LEN(SUBSTITUTE(C2,".",""))))-1) =TRIM(RIGHT(SUBSTITUTE(C2,".",REPT(" ",LEN(C2))),LEN(C2))) ABC_New.xls 024 KB Microsoft Office Excel 97-2003 Worksheet 12/30/2014 8:30:02 AM 8/4/2015 8:25:51 PM 3/30/2015 9:58:14 AM \\Server\projects\ABC_New.xls

    The path can be a local drive or server.

    1. The code should take path from a sheet range like Sheet1.Range("A2").End(Xlup) or using filedialog but not hardcoded, create folder names as excel worksheets and run one folder path at a time. Sometimes when I run above code i get Permission denied errors for recycle bin, perf logs etc for which i have no access, I have included "On Error Resume Next", but I want it to give which folder has errors and continue.

    a. Permission denied (available in 2nd code) as in "C:\PerfLogs".
    b. Formula errors if file names contains certain characters or if file has no extension. eg- "_INCAP~1" - Here i ext column it can give "No Extension" for such files.

    I asked in other forums and searched the web but I didn't get the exact result but got very similar using FileScriptingObject but not DIR. Is it possible only with DIR command Or need to combine both FileScriptingObject & DIR.

    Thanks in Advance
    VijaySM
    Last edited by VijaySM; 12-04-2015 at 02:39 PM.

  2. #2
    Senior Member
    Join Date
    Jun 2012
    Posts
    337
    Rep Power
    12
    Last edited by DocAElstein; 09-22-2023 at 05:02 PM.

  3. #3
    Junior Member
    Join Date
    Dec 2015
    Posts
    3
    Rep Power
    0
    @snb - I use excel in office and want to learn vba as it reduces many of my repeated tasks. I want to take the list of files and folders in a network path with large number of files. If I do this manually, it will be a very difficult and repetitive work. I tried vbscript but it is also slow and not get all the details. I searched for this from web and got many code snippets, used them and compared and I found the above 2 codes very useful. The 2nd code is slightly faster and hence I tried to modify it similar to 1st code. I was unable to modify as it uses array and I am getting error. So I posted it here as I saw many users have asked similar questions. I found one similar thread to get the details of mp3 files but again I could not modify it for any file type. The answer given in other forum to use CMD shellobject give results but is also very slow.

    http://www.ozgrid.com/forum/showthre...97743&p=761097

    Regarding the error handlers, I run the codes on my local computer and see if there are any errors and how the results are displayed and change some code and see how the output is got. As a hobby, I like to search the web and test the codes for doing similar tasks and very much like working with lists.

    Thank You
    VijaySM

  4. #4
    Junior Member
    Join Date
    Dec 2015
    Posts
    3
    Rep Power
    0
    Hi Excel Experts

    Any response regarding the above question. Also, If the folder length exceeds 260 characters as some files downloaded from web have more than 260 characters, Dir throws error "file not found". My question to this error is whether a workaround can be made and code should not skip the folder or file.

    Regards
    VijaySM

Similar Threads

  1. Replies: 2
    Last Post: 03-09-2015, 11:26 PM
  2. Code to open up files in folder and sub-folder
    By Howardc in forum Excel Help
    Replies: 7
    Last Post: 08-26-2014, 07:01 AM
  3. Replies: 6
    Last Post: 04-15-2014, 03:58 PM
  4. Replies: 15
    Last Post: 08-23-2013, 12:03 PM
  5. List Of All Files In A Folder
    By Excel Fox in forum Excel Help
    Replies: 2
    Last Post: 10-27-2011, 09:10 AM

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •