Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- Sub ListAllFilesAndFolders()
- Dim ws As Worksheet
- Dim fso As Object
- Dim mainFolder As Object
- Dim subFolder As Object
- Dim file As Object
- Dim folderPath As String
- Dim rowNum As Integer
- ' Create or set worksheet
- On Error Resume Next
- Set ws = Sheets("File List")
- On Error GoTo 0
- If ws Is Nothing Then
- Set ws = Sheets.Add(After:=Sheets(Sheets.Count))
- ws.Name = "File List"
- End If
- ' Clear existing data
- ws.Cells.Clear
- ws.Range("A1:C1").Value = Array("Path", "Name", "Type")
- ws.Range("A1:C1").Font.Bold = True
- ' Get folder path from user
- folderPath = InputBox("Enter the folder path:", "Folder Path", "C:\")
- If folderPath = "" Then Exit Sub
- ' Check if folder exists
- Set fso = CreateObject("Scripting.FileSystemObject")
- If Not fso.FolderExists(folderPath) Then
- MsgBox "Folder does not exist!", vbExclamation
- Exit Sub
- End If
- ' Start listing files and folders
- rowNum = 2
- Application.ScreenUpdating = False
- ' Process main folder
- Set mainFolder = fso.GetFolder(folderPath)
- ' List all subfolders first
- For Each subFolder In mainFolder.SubFolders
- ws.Cells(rowNum, 1).Value = subFolder.Path
- ws.Cells(rowNum, 2).Value = subFolder.Name
- ws.Cells(rowNum, 3).Value = "Folder"
- rowNum = rowNum + 1
- ' Recursively process subfolders
- rowNum = ProcessSubFolder(subFolder, ws, rowNum)
- Next subFolder
- ' List all files in main folder
- For Each file In mainFolder.Files
- ws.Cells(rowNum, 1).Value = file.Path
- ws.Cells(rowNum, 2).Value = file.Name
- ws.Cells(rowNum, 3).Value = "File"
- rowNum = rowNum + 1
- Next file
- ' Format the worksheet
- ws.Columns("A:C").AutoFit
- ws.Activate
- Application.ScreenUpdating = True
- MsgBox "File and folder listing complete!", vbInformation
- End Sub
- Function ProcessSubFolder(parentFolder As Object, ws As Worksheet, startRow As Integer) As Integer
- Dim subFolder As Object
- Dim file As Object
- Dim rowNum As Integer
- rowNum = startRow
- ' Process all subfolders of the parent folder
- For Each subFolder In parentFolder.SubFolders
- ws.Cells(rowNum, 1).Value = subFolder.Path
- ws.Cells(rowNum, 2).Value = subFolder.Name
- ws.Cells(rowNum, 3).Value = "Folder"
- rowNum = rowNum + 1
- ' Recursively process subfolders
- rowNum = ProcessSubFolder(subFolder, ws, rowNum)
- Next subFolder
- ' Process all files in the parent folder
- For Each file In parentFolder.Files
- ws.Cells(rowNum, 1).Value = file.Path
- ws.Cells(rowNum, 2).Value = file.Name
- ws.Cells(rowNum, 3).Value = "File"
- rowNum = rowNum + 1
- Next file
- ProcessSubFolder = rowNum
- End Function
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement
