List files in a folder with Office 95 or earlier
2000-02-04 Files & Folders 0 322
In Office 95 or earlier you don't have the same easy approach to getting a list of filenames as in Office 97 or later. By creating 4 helpfunctions it's possible to get almost the same functionality:
Dim GlobalFolderList() As String, GlobalFolderCount As Long Function FolderList95(InputFolder As String) As Variant ' returns an array containing the folders in InputFolder Dim rootFolder As String, Folder As String, Folders() As String Dim FolderCount As Long rootFolder = InputFolder If Right(rootFolder, 1) <> "" Then rootFolder = rootFolder & "" Folder = Dir(rootFolder, vbDirectory) ' retrieve the first folder. FolderCount = 0 While Folder <> "" ' start the loop. ' ignore the current directory and the encompassing directory. If Folder <> "." And Folder <> ".." Then ' Use bitwise comparison to make sure Folder is a directory. On Error GoTo FileInUse If (GetAttr(rootFolder & Folder) And vbDirectory) = vbDirectory Then FolderCount = FolderCount + 1 ReDim Preserve Folders(FolderCount) Folders(FolderCount) = Folder End If End If FileInUse: Folder = Dir() ' get next folder Wend FolderList95 = Folders ' if you only want to return the number of folders: return the value FolderCount End Function Sub RecursiveFolderList95(ByVal InputFolder As String, IncludeSubFolders As Boolean) ' adds the folders in InputFolder and any subfolders to ' the global variable GlobalFolderList Dim rootFolder As String, SubFolders As Variant Dim i As Long rootFolder = InputFolder If rootFolder = "" Then Exit Sub If GlobalFolderCount = 0 Then GlobalFolderCount = 1 ReDim Preserve GlobalFolderList(GlobalFolderCount) GlobalFolderList(GlobalFolderCount) = rootFolder End If If Right(rootFolder, 1) <> "" Then rootFolder = rootFolder & "" SubFolders = FolderList95(rootFolder) On Error GoTo NoFolder If TypeName(SubFolders) = "String()" Then ' folders found For i = 1 To UBound(SubFolders) GlobalFolderCount = GlobalFolderCount + 1 ReDim Preserve GlobalFolderList(GlobalFolderCount) GlobalFolderList(GlobalFolderCount) = rootFolder & SubFolders(i) If IncludeSubFolders Then RecursiveFolderList95 rootFolder & SubFolders(i), IncludeSubFolders End If Next i End If NoFolder: Erase SubFolders End Sub Function FolderFileList95(ByVal InputFolder As String, FileFilter As String) As Variant ' returns an array containing the files matching ' the FileFilter in InputFolder Dim List() As String, tFile As String, fCount As Long FolderFileList95 = "" If InputFolder = "" Then InputFolder = CurDir If Right(InputFolder, 1) <> "" Then InputFolder = InputFolder & "" If FileFilter = "" Then FileFilter = "*.*" tFile = Dir(InputFolder & FileFilter) fCount = 0 While tFile <> "" fCount = fCount + 1 ReDim Preserve List(fCount) List(fCount) = tFile tFile = Dir Wend If fCount > 0 Then FolderFileList95 = List ' if you only want to return the number of files: return the value fCount Erase List End Function Function CreateFileList95(FileFilter As String, IncludeSubFolder As Boolean) As Variant ' returns the full filename for files matching ' the filter criteria in the current folder Dim FileList() As String, FileCount As Long, f As Long, Dim tempList As Variant, i As Long Erase GlobalFolderList ' global variable: Dim GlobalFolderList() as String GlobalFolderCount = 0 ' global variable: Dim GlobalFolderCount as Long If FileFilter = "" Then FileFilter = "*.*" ' all files Application.StatusBar = "Reading folder information..." RecursiveFolderList95 CurDir, IncludeSubFolder If GlobalFolderCount > 0 Then ' folders found, find files Application.StatusBar = "Reading file information..." For f = 1 To GlobalFolderCount tempList = FolderFileList95(GlobalFolderList(f), FileFilter) If TypeName(tempList) = "String()" Then For i = 1 To UBound(tempList) FileCount = FileCount + 1 ReDim Preserve FileList(FileCount) FileList(FileCount) = GlobalFolderList(f) & "" & tempList(i) Next i End If Next f End If CreateFileList95 = FileList ' if you only want to return the number of files: return the value FileCount Erase GlobalFolderList Erase FileList Application.StatusBar = False End Function Sub TestCreateFileList95() Const SearchRootFolder as String = "C:My Documents" Dim MyFiles As Variant, i As Long Application.ScreenUpdating = False Application.StatusBar = "Creating file list..." ChDrive Left(SearchRootFolder, 1) ' activate the desired drive ChDir SearchRootFolder ' activate the desired folder MyFiles = CreateFileList95("*.xls", True) i = 0 On Error Resume Next i = Ubound(MyFiles) On Error Goto 0 If i = 0 Then ' no files found MsgBox "No files matches the file criteria!" Exit Sub End If Workbooks.Add With Range("A1") .Formula = "List of *.xls-files in " & CurDir & " and subfolders:" .Font.Bold = True End With For i = 1 To UBound(MyFiles) Cells(i + 1, 1).Formula = MyFiles(i) Next i Columns("A").AutoFit Application.StatusBar = False End Sub