'=====================================================================================
'- USE FileSystemObject TO LIST FOLDERS & FILES
'- ... to worksheet called "List-Folders-Files"
'- Brian Baulsom October 2004
'=====================================================================================
'- Need to set 'BaseFolder' variable
Const BaseFolder As String = "F:\XL_MACROS\"
'==============================================
Dim MySheet As Worksheet
Dim ToRow As Long
'----------------------------------------------
Dim FSO As Object ' FileSystemObject
Dim FolderName As String
Dim FolderPath As String
Dim FolderSpec As String
Dim FileSpec As String
'=====================================================================================
'- MAIN ROUTINE : SET START FOLDER & GET ITS FILES - THEN GET SUB FOLDERS
'=====================================================================================
Sub LIST_FOLDERS_FILES()
'- initialise variables
Set FSO = CreateObject("Scripting.FileSystemObject")
Set MySheet = Worksheets("List-Folders-Files")
Application.Calculation = xlCalculationManual
ChDrive BaseFolder
ChDir BaseFolder
'- set up worksheet
MySheet.Columns("A:D").ClearContents
MySheet.Range("A1:D1").Value = Array("FOLDER", "FILE NAME", "CREATED", "SIZE")
'--------------------------------------------------------------------------------
'- CALL FILE SUBROUTINE FOR BASE FOLDER
MySheet.Cells(2, 1).Value = BaseFolder
Application.StatusBar = BaseFolder
ToRow = 2
ShowFileList (BaseFolder)
'-------------------------------------------------------------------------------
'- CALL FOLDER SUBROUTINE (WHICH CALLS THE FILE ROUTINE)
ShowFolderList (BaseFolder)
'-------------------------------------------------------------------------------
'- FINISH
MsgBox ("Done")
Application.Calculation = xlCalculationAutomatic
Application.StatusBar = False
End Sub
'======== END OF MAIN ROUTINE =======================================================
'=====================================================================================
'- SUBROUTINE : GET SUBFOLDERS OF SPECIFIED FOLDER
'=====================================================================================
Private Sub ShowFolderList(FolderSpec)
Dim f, f1, fc, s
Set f = FSO.GetFolder(FolderSpec)
Set fc = f.subfolders
'---------------------------------------------------------------------------------
'- CHECK SUBFOLDER COUNT
If fc.Count = 0 Then
Exit Sub
Else
'- LOOP FOLDERS
For Each f1 In fc
FolderName = f1.Path
Application.StatusBar = FolderName
MySheet.Cells(ToRow, 1).Value = FolderName
ShowFileList (FolderName)
'-----------------------------------------------------------------------
'- CALL SELF TO GET ANY SUBFOLDERS IN THIS SUBFOLDER
ShowFolderList (FolderName)
'------------------------------------------------------------------------
Next
End If
'--------------------------------------------------------------------------------
End Sub
'-
'=====================================================================================
'- SUBROUTINE : TO LIST FILES IN FOLDER
'=====================================================================================
Private Sub ShowFileList(FileSpec)
Dim f, f1, fc, Spec
Set f = FSO.GetFolder(FileSpec)
Set fc = f.Files
'--------------------------------------------------------------------------------
'- CHECK FILE COUNT
If fc.Count = 0 Then
ToRow = ToRow + 1
Exit Sub
Else
'- LOOP FILES
For Each f1 In fc
Set Spec = FSO.GetFile(f1) ' individual file info
MySheet.Cells(ToRow, 2).Value = f1.Name
MySheet.Cells(ToRow, 3).Value = Spec.datecreated
MySheet.Cells(ToRow, 4).Value = Spec.Size 'bytes
ToRow = ToRow + 1
Next
End If
'---------------------------------------------------------------------------------
End Sub
'=== END OF PROJECT ==================================================================