PDA

View Full Version : Solved: get a list of files from Directory order by the date modified



parscon
04-28-2012, 06:34 AM
I have This VBA code that will export all files name from a directory but now i need list (sort) the files name by the modified date . how can i add this option to this VBA Code ?

Thank you .

Option Explicit
Sub GetFileNames()
Dim xRow As Long
Dim xDirect$, xFname$, InitialFoldr$
InitialFoldr$ = "G:\" '<<< 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) & "\"
xFname$ = Dir(xDirect$, 7)
Do While xFname$ <> ""
ActiveCell.Offset(xRow) = xFname$
xRow = xRow + 1
xFname$ = Dir
Loop
End If
End With
End Sub

Kenneth Hobs
04-28-2012, 07:34 AM
This should get your started. I did not know if you wanted to add a column for the dates or just use the adjacent so I used the latter.

You can add the sort part. I did not know if you want just the filenames sorted or the rows with the filenames. A recorded macro will show the syntax.

Sub GetFileNames()
Dim xRow As Long
Dim xDirect$, xFname$, InitialFoldr$
Dim cell As Range, fso As Object

InitialFoldr$ = "x:\t\" '<<< 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) & "\"
xFname$ = Dir(xDirect$, 7)
Do While xFname$ <> ""
ActiveCell.Offset(xRow) = xFname$
xRow = xRow + 1
xFname$ = Dir
Loop
End If
End With

Set fso = CreateObject("Scripting.FileSystemObject")
On Error Resume Next
For Each cell In Range(ActiveCell, ActiveCell.Offset(xRow))
cell.Offset(0, 1).Value = fso.getfile(xDirect$ & cell.Value2).DateLastModified
Next cell
Set fso = Nothing
On Error GoTo 0
End Sub

parscon
04-28-2012, 07:38 AM
Really Thank you so much just if is possible add a column for size of files ?

Thank you again .

Bob Phillips
04-28-2012, 07:50 AM
Set fso = CreateObject("Scripting.FileSystemObject")
On Error Resume Next
For Each cell In Range(ActiveCell, ActiveCell.Offset(xRow))
cell.Offset(0, 1).Value = fso.getfile(xDirect$ & cell.Value2).DateLastModified
cell.Offset(0, 2).Value = fso.getfile(xDirect$ & cell.Value2).Size
Next cell
Set fso = Nothing
On Error GoTo 0

parscon
04-28-2012, 08:00 AM
Thank you so much .