Print file names in folder to Excel Sheet in order of file creation date

Question

Hi there I have a procedure that prints file names found in a folder to an excel sheet, but I wonder if it could be modified so that it sorts the files in the folder by file Date Modified (like in the explorer) first and then prints the file names in that order to the sheet. Any help would be appreciated!

Sub HGDW_PrintFiles()
    Dim objFSO As Object
    Dim objFolder As Object
    Dim objFile As Object
    Dim i As Integer

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

    'Get the folder object
    Set objFolder = objFSO.Getfolder("C:\Users\bf91955\Desktop\Test\")
    i = 1

    'loops through each file in the directory and prints their names and path
    For Each objFile In objFolder.Files
        'print file name to column a
        Cells(i, 1) = objFile.Name
        i = i + 1
    Next objFile
End Sub

therefore you would need to read also the `objFile.DateLastModified` and use eg an array, dictionary or collection to sort them before you print them into the worksheet. But you could also print name and date into the sheet and sort the range afterwards. — Pᴇʜ, Jan 16 '18 at 09:27
Printing name and creation date seems like an easier approach for my skill level haha. How would I go about it? Could you post your idea as an answer? — Rhyfelwr, Jan 16 '18 at 09:31
Is it creation date or last modified date? You can use command prompt to get creation date order. — QHarr, Jan 16 '18 at 09:31
Well as of now I have to go into the Explorer and manually press the filter "Date modified" before running the macro. So it is modified date yeah. — Rhyfelwr, Jan 16 '18 at 09:32
Damn. That's a nice script i wrote before out the window :-) — QHarr, Jan 16 '18 at 09:41

Pᴇʜ · Accepted Answer · 2018-01-16T09:50:10.707

This would read it into an array and then bubble sort the array before output. The sorting here happens in the VBA array which should be faster than a sorting in the worksheet range.

Sub ReadFiles()
    Dim strFolder As String
    Dim fso As Object
    Dim fld As Object
    Dim fil As Object
    Dim arrNames() As String
    Dim arrDates() As Date
    Dim i As Long
    Dim j As Long
    Dim n As Long
    Dim strTmp As String
    Dim dtmTmp As Date

    Set fso = CreateObject("Scripting.FileSystemObject")
    ' Modify as needed
    strFolder = "C:\"
    Set fld = fso.GetFolder(strFolder)

    ' Set up arrays
    n = fld.Files.Count
    ReDim arrNames(1 To n)
    ReDim arrDates(1 To n)

    ' Fill arrays
    For Each fil In fld.Files
        i = i + 1
        arrNames(i) = fil.Name
        arrDates(i) = fil.DateLastModified
    Next fil

    ' Bubble sort descending on date
    For i = 1 To n - 1
        For j = i + 1 To n
            If arrDates(i) < arrDates(j) Then 'to sort ascending change < to >
                dtmTmp = arrDates(i)
                arrDates(i) = arrDates(j)
                arrDates(j) = dtmTmp
                strTmp = arrNames(i)
                arrNames(i) = arrNames(j)
                arrNames(j) = strTmp
            End If
        Next j
    Next i

    ' Do something with the arrays, e.g.
    For i = 1 To n
        Debug.Print arrNames(i)
    Next i
End Sub

So I'd just put `PrintArray arrNames, ActiveWorkbook.Worksheets("Sheet1").Cells(i, 1)` in the end to print the array to the sheet right? — Rhyfelwr, Jan 16 '18 at 09:41
I don't know what `PrintArray` is but `ActiveWorkbook.Worksheets("Sheet1").Cells(i, 1) = arrNames(i)` should work (instead of `Debug.Print arrNames(i)`). — Pᴇʜ, Jan 16 '18 at 09:43

score -1 · Answer 2 · answered Jan 16 '18 at 09:35

-1

Sub HGDW_PrintFiles()
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim i As Integer


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

'Get the folder object
Set objFolder = objFSO.Getfolder("C:\Users\bf91955\Desktop\Test\")
i = 1

'loops through each file in the directory and prints their names and path
For Each objFile In objFolder.Files
    'print file name to column a, column b is date last modified
     Cells(i, 1) = objFile.Name
     Cells(i, 2) = objFile.DateLastModified

    i = i + 1
Next objFile

Range("A1").Select
Selection.End(xlDown).Select

'sort most recent
ActiveWorkbook.Worksheets("Hoja1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Hoja1").Sort.SortFields.Add Key:=Range("B1"), _
    SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
    xlSortTextAsNumbers
With ActiveWorkbook.Worksheets(ActiveSheet.Name).Sort
    .SetRange Range("A1:B" & ActiveCell.Row)
    .Header = xlNo
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
    End With
End Sub

answered Jan 16 '18 at 09:35

Foxfire And Burns And Burns

10,665
2
17
38

1

I highly recommend to avoid using `Select` and `Selection` this is a very bad practice. Also instead of `ActiveWorkbook` you probably meant to use `ThisWorkbook` . Also `ActiveWorkbook.Worksheets(ActiveSheet.Name).Sort` doesn't make much sense if you just could use `ActiveSheet.Sort` directly. But instead of `ActiveSheet` I recommend to use a full referenced worksheet. – Pᴇʜ Jan 16 '18 at 09:41
Is it a recorded macro? Doesn't seem like the solution to my problem, but thank you for your input! The sort by date should happen before the filenames are printed to the sheet. – Rhyfelwr Jan 16 '18 at 09:42
Nope, the code print first the filenames in A column and date Last Modified in Column B. I had a macro that gets me the size of files so i can clean biggest files and i adapted to show Date Last Modified and then order by most recent (yep, it's recorded and adapted) – Foxfire And Burns And Burns Jan 16 '18 at 09:45
But just wondering, why do you want first to sort the results in array and then print the names if the result is the same? – Foxfire And Burns And Burns Jan 16 '18 at 09:46
1

@FoxfireAndBurnsAndBurns But sorting arrays should be much faster than sorting a range. And it's not the same because you need a column for the dates. But if you sort in an array you don't need to print the dates. – Pᴇʜ Jan 16 '18 at 09:47

score -1 · Answer 3 · answered Jan 17 '18 at 03:45

The sample file from the link below will do what you want, and a whole lot more. Just click the button named 'Download Now' to get started.

http://learnexcelmacro.com/wp/2011/11/how-to-get-list-of-all-files-in-a-folder-and-sub-folders/

'**********************************************************************
'*                                                                    *
'* Written by Vish Mishra - http://www.LearnExcelMacro.Com            *
'* You can list down all the files with properties at once place      *
'* Just by one click using this File Manager                          *
'*                                                                    *
'**********************************************************************

Public fPath As String
Public IsSubFolder As Boolean
Public iRow As Long
Public FSO As Scripting.FileSystemObject
Public SourceFolder As Scripting.folder, SubFolder As Scripting.folder
Public FileItem As Scripting.File
Public IsFileTypeExists As Boolean



Public Sub ListFilesInFolder(SourceFolder As Scripting.folder, IncludeSubfolders As Boolean)


    On Error Resume Next
    For Each FileItem In SourceFolder.Files


' display file properties
        Cells(iRow, 2).Formula = iRow - 13
        Cells(iRow, 3).Formula = FileItem.Name
        Cells(iRow, 4).Formula = FileItem.Path
        Cells(iRow, 5).Formula = Int(FileItem.Size / 1024)
        Cells(iRow, 6).Formula = FileItem.Type
        Cells(iRow, 7).Formula = FileItem.DateLastModified
        Cells(iRow, 8).Select
        Selection.Hyperlinks.Add Anchor:=Selection, Address:= _
        FileItem.Path, TextToDisplay:="Click Here to Open"

'Cells(iRow, 8).Formula = "=HYPERLINK(""" & FileItem.Path & """,""" & "Click Here to Open" & """)"

        iRow = iRow + 1 ' next row number
        Next FileItem

        If IncludeSubfolders Then
            For Each SubFolder In SourceFolder.SubFolders
                ListFilesInFolder SubFolder, True
                Next SubFolder
            End If

            Set FileItem = Nothing
            Set SourceFolder = Nothing
            Set FSO = Nothing



        End Sub




        Public Sub ListFilesInFolderXtn(SourceFolder As Scripting.folder, IncludeSubfolders As Boolean)


            On Error Resume Next
            Dim FileArray As Variant

            FileArray = Get_File_Type_Array

            For Each FileItem In SourceFolder.Files

                Call ReturnFileType(FileItem.Type, FileArray)

                If IsFileTypeExists = True Then

                    Cells(iRow, 2).Formula = iRow - 13
                    Cells(iRow, 3).Formula = FileItem.Name
                    Cells(iRow, 4).Formula = FileItem.Path
                    Cells(iRow, 5).Formula = Int(FileItem.Size / 1024)
                    Cells(iRow, 6).Formula = FileItem.Type
                    Cells(iRow, 7).Formula = FileItem.DateLastModified

                    Cells(iRow, 8).Select
                    Selection.Hyperlinks.Add Anchor:=Selection, Address:= _
                    FileItem.Path, TextToDisplay:="Click Here to Open"

'Cells(iRow, 8).Formula = "=HYPERLINK(""" & FileItem.Path & """,""" & "Click Here to Open" & """)"

                    iRow = iRow + 1 ' next row number

                End If
                Next FileItem

                If IncludeSubfolders Then
                    For Each SubFolder In SourceFolder.SubFolders
                        ListFilesInFolderXtn SubFolder, True
                        Next SubFolder
                    End If

                    Set FileItem = Nothing
                    Set SourceFolder = Nothing
                    Set FSO = Nothing



                End Sub



                Sub ResultSorting(xlSortOrder As String, sKey1 As String, sKey2 As String, sKey3 As String)
                    Range("C13").Select
                    Range(Selection, Selection.End(xlDown)).Select
                    Range(Selection, Selection.End(xlToRight)).Select

                    Selection.Sort Key1:=Range(sKey1), Order1:=xlSortOrder, Key2:=Range(sKey2 _
                    ), Order2:=xlAscending, Key3:=Range(sKey3), Order3:=xlSortOrder, Header _
                    :=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom _
                    , DataOption1:=xlSortNormal, DataOption2:=xlSortNormal, DataOption3:= _
                    xlSortNormal

                    Range("B14").Select
                End Sub


                Sub ClearResult()
                    If Range("B14") <> "" Then

                        Range("B14").Select
                        Range(Selection, Selection.End(xlDown)).Select
                        Range(Selection, Selection.End(xlToRight)).Select
                        Range(Selection.Address).ClearContents
                    End If
                End Sub


                Public Function Get_File_Type_Array() As Variant

                    Dim i, j, TotalSelected As Integer
                    Dim arrList() As String
                    TotalSelected = 0
                    For i = 0 To Sheet1.ListBoxFileTypes.ListCount - 1
                        If Sheet1.ListBoxFileTypes.Selected(i) = True Then
                            TotalSelected = TotalSelected + 1
                        End If
                    Next

                    ReDim arrList(0 To TotalSelected - 1) As String
                    j = 0
                    i = 0
                    For i = 0 To Sheet1.ListBoxFileTypes.ListCount - 1

                        If Sheet1.ListBoxFileTypes.Selected(i) = True Then
                            arrList(j) = Left(Sheet1.ListBoxFileTypes.List(i), InStr(1, Sheet1.ListBoxFileTypes.List(i), "(") - 1)
                            j = j + 1
                        End If

                    Next

                    Get_File_Type_Array = arrList

                End Function


                Public Function ReturnFileType(fileType As String, FileArray As Variant) As Boolean

                    Dim i As Integer

                    IsFileTypeExists = False

                    For i = 1 To UBound(FileArray) + 1

                        If FileArray(i - 1) = fileType Then

                            IsFileTypeExists = True
                            Exit For

                        Else
                            IsFileTypeExists = False
                        End If

                    Next

                End Function



                Sub textfile(iSeperator As String)

                    Dim iRow, iCol
                    Dim iLine, f




                    ThisWorkbook.Activate
                    Range("B13").Select
                    TotalRowNumber = Range(Selection, Selection.End(xlDown)).Count - 12

                    If iSeperator <> "vbTab" Then

                        Open ThisWorkbook.Path & "\File1.txt" For Output As #1
                        Print #1, ""
                        Close #1

                        Open ThisWorkbook.Path & "\File1.txt" For Append As #1
                        For iRow = 13 To TotalRowNumber

                            iLine = ""

                            For iCol = 2 To 7

                                iLine = iLine & iSeperator & Cells(iRow, iCol).Value
                            Next
                            Print #1, iLine
                        Next
                        Close #1


                    Else

                        Open ThisWorkbook.Path & "\File1.txt" For Output As #1
                        Print #1, ""
                        Close #1

                        Open ThisWorkbook.Path & "\File1.txt" For Append As #1
                        For iRow = 13 To TotalRowNumber

                            iLine = ""

                            For iCol = 2 To 7

                                iLine = iLine & vbTab & Cells(iRow, iCol).Value
                            Next
                            Print #1, iLine
                        Next
                        Close #1

                    End If



                    f = Shell("C:\WINDOWS\notepad.exe " & ThisWorkbook.Path & "\File1.txt", vbMaximizedFocus)

'MsgBox "Your File is saved" & ThisWorkbook.Path & "\File1.txt"

                End Sub





                Sub Export_to_excel()
                    On Error GoTo err



                    Dim xlApp As New Excel.Application
                    Dim xlWB As New Workbook

                    Set xlWB = xlApp.Workbooks.Add
'xlWB.Add
                    xlApp.Visible = False


                    ThisWorkbook.Activate
                    Range("B13").Select
                    Range(Selection, Selection.End(xlDown)).Select
                    Range(Selection, Selection.End(xlToRight)).Select

                    Selection.Copy

                    xlApp.Visible = True
                    xlWB.Activate
                    xlWB.Sheets("Sheet1").Select
                    xlWB.Sheets("Sheet1").Range("B2").PasteSpecial Paste:=xlPasteValues
                    xlWB.Sheets("Sheet1").Cells.Select
                    xlWB.Sheets("Sheet1").Cells.EntireColumn.AutoFit
                    xlWB.Sheets("Sheet1").Range("B2").Select
                    Exit Sub
err:
                    MsgBox ("Error Occured while exporting. Try again")

                End Sub

In a productive environment using `On Error Resume Next` as first line without catching an error at all is a very bad practice and should be avoided. This only mutes **any** error but they still occur, you just don't see them = bad idea. Instead you should implement a good error handling. Also using `xlSortOrder` as a variable name is a bad idea because it is already a reserved word for the [XlSortOrder Enumeration](https://msdn.microsoft.com/en-us/vba/excel-vba/articles/xlsortorder-enumeration-excel). Using `Select` should be avoided too, because of bad practice. — Pᴇʜ, Jan 17 '18 at 07:43
And `Dim i, j, TotalSelected As Integer` only declares `TotalSelected As Integer` but `i` and `j` remain of type `Variant`. Also [using `Long` instead of `Integer` should be a good idea](https://stackoverflow.com/a/26409520/3219613). In this code are many "*how you don't do it*"s, however I recommend not to use it in production. — Pᴇʜ, Jan 17 '18 at 07:49

Print file names in folder to Excel Sheet in order of file creation date

3 Answers3