VBA File lister full folder path
Mon Jan 15 2024 06:23:22 GMT+0000 (Coordinated Universal Time)
Saved by
@miskat80
Sub ListFilesInFolderAndSubfolders()
On Error GoTo ErrHandler
Dim selectedFolder As FileDialog
Set selectedFolder = Application.FileDialog(msoFileDialogFolderPicker)
Dim selectedPath As String
If selectedFolder.Show = -1 Then
selectedPath = selectedFolder.SelectedItems(1)
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets.Add
ws.Cells(1, 1).Value = "Folder Path"
ws.Cells(1, 2).Value = "File Name"
Dim startCell As Range
Set startCell = ws.Cells(2, 1)
ListFilesRecursive selectedPath, selectedPath, startCell
MsgBox "File listing completed.", vbInformation
Else
MsgBox "No folder selected.", vbExclamation
End If
Exit Sub
ErrHandler:
MsgBox "An error occurred: " & Err.Description, vbCritical
End Sub
Sub ListFilesRecursive(ByVal folderPath As String, ByVal parentFolderPath As String, ByRef targetCell As Range)
Dim folder As Object, subFolder As Object
Dim file As Object
Dim fs As Object
Dim subFolderPath As String
Set fs = CreateObject("Scripting.FileSystemObject")
Set folder = fs.GetFolder(folderPath)
For Each file In folder.Files
targetCell.Value = parentFolderPath
targetCell.Offset(0, 1).Value = file.Name
Set targetCell = targetCell.Offset(1, 0)
Next file
For Each subFolder In folder.SubFolders
subFolderPath = subFolder.Path
ListFilesRecursive subFolderPath, subFolderPath, targetCell
Next subFolder
Set fs = Nothing
Set folder = Nothing
Set subFolder = Nothing
Set file = Nothing
End Sub
content_copyCOPY
Comments