Get File Names in a Folder
Names of all the files in a folder Excluding Sub folder
If you want to get the names of all the files stored in a folder and excluding the files stored in a sub folder.Try below code-
Option Explicit
Sub file_names_in_folder_without_including_files_in_subfolder()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim fldpath
Dim fld As Object, fil As Object, fso As Object, j As Long
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Choose the folder"
.Show
End With
On Error Resume Next
fldpath = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1) & "\"
If fldpath = False Then
MsgBox "Folder Not Selected"
Else
Workbooks.Add
Cells(1, 1).Value = fldpath
Cells(3, 1).Value = "Path"
Cells(3, 2).Value = "Dir"
Cells(3, 3).Value = "Name"
Cells(3, 4).Value = "Size"
Cells(3, 5).Value = "Type"
Cells(3, 6).Value = "Date Created"
Cells(3, 7).Value = "Date Last Access"
Cells(3, 8).Value = "Date Last Modified"
j = 4
Set fso = CreateObject("scripting.filesystemobject")
Set fld = fso.getfolder(fldpath)
For Each fil In fld.Files
Cells(j, 1).Value = fil.Path
Cells(j, 2).Value = Left(fil.Path, InStrRev(fil.Path, "\"))
Cells(j, 3).Value = fil.Name
Cells(j, 4).Value = fil.Size
Cells(j, 5).Value = fil.Type
Cells(j, 6).Value = fil.DateCreated
Cells(j, 7).Value = fil.DateLastAccessed
Cells(j, 8).Value = fil.DateLastModified
j = j + 1
Next
End If
Range("a1").Font.Size = 9
ActiveWindow.DisplayGridlines = False
Range("a4:h" & Range("a4").End(xlDown).Row).Font.Size = 9
Range("a3:h3").Interior.Color = vbCyan
Columns("c:h").AutoFit
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Names of all the files in a folder Including Sub folder
If you want to get the names of all the files stored in a folder and including the files stored in a sub folder.Try below code-
Sub file_names_including_sub_folder()
Application.ScreenUpdating = False
Dim fldpath
Dim fld As Object, fil As Object, fso As Object, j As Long
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Choose the folder"
.Show
End With
On Error Resume Next
fldpath = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1) & "\"
If fldpath = False Then
MsgBox "Folder Not Selected"
Exit Sub
End If
Workbooks.Add
Cells(1, 1).Value = fldpath
Cells(2, 1).Value = "Path"
Cells(2, 2).Value = "Dir"
Cells(2, 3).Value = "Name"
Cells(2, 4).Value = "Size"
Cells(2, 5).Value = "Type"
Cells(2, 6).Value = "Date Created"
Cells(2, 7).Value = "Date Last Access"
Cells(2, 8).Value = "Date Last Modified"
Set fso = CreateObject("scripting.filesystemobject")
Set fld = fso.getfolder(fldpath)
j = 4
get_sub_foldernames fld
Range("a1").Font.Size = 9
ActiveWindow.DisplayGridlines = False
Range("a3:h" & Range("a4").End(xlDown).Row).Font.Size = 9
Range("a2:h2").Interior.Color = vbCyan
Columns("c:h").AutoFit
Application.ScreenUpdating = True
End Sub
Sub get_sub_foldernames(ByRef prntfld As Object)
Dim subfld As Object, fil As Object, j As Long
For Each fil In prntfld.Files
j = Range("A1").End(xlDown).Row + 1
Cells(j, 1).Value = fil.Path
Cells(j, 2).Value = Left(fil.Path, InStrRev(fil.Path, "\"))
Cells(j, 3).Value = fil.Name
Cells(j, 4).Value = fil.Size
Cells(j, 5).Value = fil.Type
Cells(j, 6).Value = fil.DateCreated
Cells(j, 7).Value = fil.DateLastAccessed
Cells(j, 8).Value = fil.DateLastModified
Next
For Each subfld In prntfld.SubFolders
get_sub_foldernames subfld
Next subfld
End Sub
- Ashish Koul's blog
- Login or register to post comments
- 6048 reads
Recent comments
5 years 42 weeks ago
6 years 28 weeks ago
6 years 40 weeks ago
6 years 42 weeks ago
6 years 43 weeks ago
6 years 49 weeks ago
7 years 5 weeks ago
7 years 5 weeks ago
7 years 5 weeks ago
7 years 5 weeks ago