trypots.nethomeRetrieving file names/paths from a folder (and subfolders):
To work with files in a folder, I have found it helpful in VBA to drop the filepaths of the files into an array . This way I can deal with capturing the array of filenames as a discrete step prior to whatever I may do with the files. As another benefit, whatever procedure I have that uses the list of files is separated from the code for retrieving the list. This provides a modular structure that is easier to maintain and promotes code re-use.
The code here implements the FileSystemObject of the Microsoft Scripting Runtime Library, which is normally already a part of your Windows operating environment. The FileSystemObject provides methods for working with files and folder. We use a rather simple set of instructions that incidentally demonstrates how a recursive procedure can do a good bit of work with very little code - the same procedure continually calls itself until it has exhausted its folder explorations. With only two flag variables, we can instruct the code to stick to only the first folder, its immediate subfolders, or all subfolders.
Below is the code for the Directory_Listing function. It's output will be a string array of all the files in the folder you give it, and optionally file from subfolders. Note that this is merely a string array of the complete filepaths for the files - the next step is up to you, namely, to do something with that list. There are three procedures listed:
- Directory_List - a public function used to call the procedure (mainly a wrapper for the "real" function but it serves a critical purpose of initializing the string array that we are aiming at)
- Directory_List_Main - a private function that iterates folders capturing file names
- Demonstrate_Directory_List - a subroutine to demonstrate using the code. It will output three lists of file names to Excel, given three different depths for searching, and additionally picking out the Excel files that it found.
Optional includeImmediateSubFolders As Boolean = False, _
Optional includeAllSubFolders As Boolean = False) As Variant
'---------------------------------------------------------------------------------
' Directory_List public function (exposes the code for use)
' Returns: Variant/Array if at least one file is found, Variant/Empty otherwise.
'---------------------------------------------------------------------------------
Dim a() As String '//Array to hold filepaths
Dim i As Long '//Counter of files found
Dim FSO As Object
Set FSO = CreateObject("Scripting.FileSystemObject")
ReDim a(0 To 0)
Call Directory_List_Main(FSO, a, i, _
startInFolder, _
includeImmediateSubFolders, _
includeAllSubFolders)
If i > 0 Then
Directory_List = a
End If
Set FSO = Nothing
End Function
Private Sub Directory_List_Main(ByRef FSO As Object, ByRef a() As String, ByRef i As Long, _
ByRef startInFolder As String, _
Optional includeImmediateSubFolders As Boolean = False, _
Optional includeAllSubFolders As Boolean = False)
'---------------------------------------------------------------------------------------
' Directory_List_Main private function (iterates files/folders to retrieve filepaths).
'---------------------------------------------------------------------------------------
Dim MyFolder As Folder
Dim mySubfolder As Folder
Dim f As File
Dim msg As String
On Error GoTo Handler
'//Error - initial folder not found
If Not (FSO.FolderExists(startInFolder)) Then
msg = "Error. Folder not Found:" & vbNewLine & startInFolder
MsgBox msg, vbExclamation
Exit Sub
End If
'//Process files in folder
With FSO
Set MyFolder = .GetFolder(startInFolder)
For Each f In MyFolder.Files
ReDim Preserve a(0 To i)
a(i) = f.Path
i = i + 1
Next f
'//optional recursive call(s) for subfolder(s)
If (includeImmediateSubFolders Or includeAllSubFolders) Then
For Each mySubfolder In MyFolder.SubFolders
Call Directory_List_Main(FSO, a, i, _
mySubfolder.Path, _
includeAllSubFolders, _
includeAllSubFolders)
Next mySubfolder
End If
End With
My_Exit:
Exit Sub
Handler:
MsgBox "Error in Sub Directory_List_Main" & Err.Number & " " & Err.Description
Set FSO = Nothing
Resume My_Exit
End Sub
Sample use of Directory_List:
'----------------------------------------------------------------------------------
'//Demonstrate Directory_List - output is four columns
' * Column A: Files in folder
' * Column B: Files in folder and immediate subfolders
' * Column C: Files in folder and all subfolder
' * Column D: Excel files found (if any) by name
'//To Run the Demonstration
' * Change the value of variable *sFolder* to a folder on your PC
' * Choose a folder with a few files in it
' * If possible, one with subfolders and nested subfolders also containing files
'----------------------------------------------------------------------------------
Dim a, b() As String
Dim i As Long, j As Long
Dim wb As Workbook
Dim sFolder As String
Dim FSO As FileSystemObject
sFolder = "C:\myTemp"
Set wb = Workbooks.Add
'//Get an array of filepaths in folder (output to Excel).
a = Directory_List(sFolder, False, False)
If IsEmpty(a) Then
wb.Sheets(1).Cells(1, 1) = "File in Folder: " & sFolder & " (0 found)"
Else
With wb.Sheets(1)
.Cells(1, 1) = "Files in Folder: " & sFolder & " (" & UBound(a) + 1 & " found)"
.Cells(2, 1).Resize(UBound(a) + 1).Value = WorksheetFunction.Transpose(a)
.Cells(1, 1).Font.Bold = True
.Cells(1, 1).WrapText = True
.Cells(1, 1).VerticalAlignment = -4160
.Columns(1).ColumnWidth = 35
.Columns(2).ColumnWidth = 1.5
.Rows(1).AutoFit
End With
'//Run again, this time including immediate subfolders (output to Excel).
a = Directory_List(sFolder, True, False)
With wb.Sheets(1)
.Cells(1, 3) = "Files in Folder and Immediate SubFolders: " _
& sFolder & " (" & UBound(a) + 1 & " found)"
.Cells(2, 3).Resize(UBound(a) + 1).Value = WorksheetFunction.Transpose(a)
.Cells(1, 3).Font.Bold = True
.Cells(1, 3).WrapText = True
.Cells(1, 3).VerticalAlignment = -4160
.Columns(3).ColumnWidth = 35
.Columns(4).ColumnWidth = 1.5
.Rows(1).AutoFit
End With
'//Run again, this time including all subfolders (output to Excel).
a = Directory_List(sFolder, True, True)
With wb.Sheets(1)
.Cells(1, 5) = "File in Folder and All SubFolders: " & sFolder _
& " (" & UBound(a) + 1 & " found)"
.Cells(2, 5).Resize(UBound(a) + 1).Value = WorksheetFunction.Transpose(a)
.Cells(1, 5).Font.Bold = True
.Cells(1, 5).WrapText = True
.Cells(1, 5).VerticalAlignment = -4160
.Columns(5).ColumnWidth = 35
.Columns(6).ColumnWidth = 1.5
.Rows(1).AutoFit
End With
End If
'//List Excel files found (output to Excel).
Set FSO = CreateObject("Scripting.FileSystemObject")
For i = 0 To UBound(a)
If LCase(FSO.GetFile(a(i)).Type) Like "*excel*" Then
ReDim Preserve b(0 To j)
b(j) = FSO.GetFileName(a(i))
j = j + 1
End If
Next i
If j > 0 Then
With wb.Sheets(1)
.Cells(1, 7).Value = "Excel Files Found: " & " (" & UBound(b) + 1 & " found)"
.Cells(2, 7).Resize(UBound(b) + 1).Value = WorksheetFunction.Transpose(b)
.Cells(1, 7).Font.Bold = True
.Cells(1, 7).WrapText = True
.Cells(1, 7).VerticalAlignment = -4160
.Columns(7).ColumnWidth = 35
.Rows(1).AutoFit
End With
End If
wb.Saved = True
End Sub