VBA to run a list all folder & subfolder content with column headers

xcellrodeo

Board Regular
Joined
Oct 27, 2008
Messages
206
Hi, I wonder if I could ask for some help from some very intelligent people out there.
I would like some help with creating a VBA script that returns a complete list of folders and subfolder content in a given location.
The starting point could be a text box which opens and the user has to enter a full file path which the VBA will then run from and return the results in Tab "List Details".
In the 'List Details' tab, I would like the VBA search results to be organised under the column headers in the format below:

Column A -> File Name:
Column B -> File Path:
Column C -> Folder Name (where file is located):
Column D -> Sub Folder Name (where file is located):
Column E -> File Ext (i.e jpg, xls, pdf...) :
Column F -> Date last modified:

Any help with the above would be greatly appreciated.
Thanks
 

Zot

Well-known Member
Joined
Nov 26, 2020
Messages
1,863
Office Version
  1. 2016
Platform
  1. Windows
This vba is to reply the OP for possible solution even if this is rather old post. This is using late binding. This presumed that you have already had a sheet called List Details.
VBA Code:
Sub GetFileList()

Dim SelectFolder As Integer
Dim x As Long
Dim strPath As String
Dim wsList As Worksheet
Dim wb As Workbook
Dim FSO As Object
Dim FSOFolder As Object
Dim sFileName As Object

Set wsList = ActiveWorkbook.Sheets("List Details")
wsList.Range("A1") = "File Name"
wsList.Range("B1") = "File Path"
wsList.Range("C1") = "Folder Name"
wsList.Range("D1") = "subFolder Name"
wsList.Range("E1") = "File Ext"
wsList.Range("F1") = "Last Modified"

SelectFolder = Application.FileDialog(msoFileDialogFolderPicker).Show

If Not SelectFolder = 0 Then
    strPath = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1) & "\"
Else
    End
End If

Application.ScreenUpdating = False

Set FSO = CreateObject("Scripting.FileSystemObject")
Set FSOFolder = FSO.GetFolder(strPath)

LoopSubFolder FSO.GetFolder(strPath), wsList

End Sub

Sub LoopSubFolder(FSOFolder As Object, wsList As Worksheet)

Dim FName As String, FNameNoExt As String
Dim FSO As Object
Dim FSOSubFolder As Object
Dim FSOFile As Object

Set FSO = CreateObject("Scripting.FileSystemObject")

For Each FSOSubFolder In FSOFolder.Subfolders
    LoopSubFolder FSOSubFolder, wsList
Next

' Extract Detail
For Each FSOFile In FSOFolder.Files
    FName = FSOFile.Name
    FNameNoExt = Left(FName, InStr(FName, ".") - 1)
    wsList.Cells(Rows.Count, "A").End(xlUp).Offset(1) = FNameNoExt
    wsList.Cells(Rows.Count, "B").End(xlUp).Offset(1) = FSOFolder.Path
    wsList.Cells(Rows.Count, "C").End(xlUp).Offset(1) = FSO.GetParentFolderName(FSOFolder.Path)
    wsList.Cells(Rows.Count, "D").End(xlUp).Offset(1) = FSOFolder.Name
    wsList.Cells(Rows.Count, "E").End(xlUp).Offset(1) = Right(FName, Len(FName) - (Len(FNameNoExt) + 1))
    wsList.Cells(Rows.Count, "F").End(xlUp).Offset(1) = FSOFile.DateLastModified
Next

End Sub
 

Excel Facts

Excel Joke
Why can't spreadsheets drive cars? They crash too often!

Forum statistics

Threads
1,147,477
Messages
5,741,356
Members
423,657
Latest member
Medrok2021

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top