I was inspired to throw this class together by an SO question and thought I'd subject it to some welcome criticism here.
The class is basically just a wrapper around the shell utility dir
, and is intended as a replacement for the built in Dir$
function. The rationale for replacing the function is that it has many more features than either the built in VBA functionality or the Scripting.FileSystemObject
when it comes to directory listings. For example, Dir$
won't recurse subdirectories, Scripting.FileSystemObject
won't take wildcards, and neither of them will filter for file attributes or sort the output. This class serves to fill that gap.
Disclaimer: This is essentially a rough draft waiting to be extended. Known limitations include:
- It doesn't test for conflicting attribute or sort flags. The
dir
utility doesn't either, but an extension should probably extend. This gives it slightly different behaviour because the parameter order is the tie breaker fordir
. - It should probably have the option to specify whether or not to return the full path as opposed to the just the file. The behaviour currently depends on whether the
RecurseSubDirectories
property is set toTrue
orFalse
(just likedir
, but again the ultimate goal is to extend). - The command window popping up from the
WScript.Shell.Exec
call is annoying. This will likely require some future API hacks. - Other things I'm not thinking of. ;-)
All code other than the usage example is in DirectoryListing.cls
.
Header: The FileAttributes
and SortOrder
enumerations are used as flags. TimeField
values can't be combined, so they are a straight up Enum
. There's probably some room for criticism here...
Option Explicit
Public Enum FileAttributes
Default = 0
HiddenFiles = 2 ^ 0
NonHiddenFiles = 2 ^ 1
SystemFiles = 2 ^ 2
NonSystemFiles = 2 ^ 3
DirectoriesOnly = 2 ^ 4
FilesOnly = 2 ^ 5
ArchiveReady = 2 ^ 6
NonArchiveReady = 2 ^ 7
ReadOnly = 2 ^ 8
NonReadOnly = 2 ^ 9
End Enum
Public Enum SortOrder
Default = 0
NameAscending = 2 ^ 0
NameDescending = 2 ^ 1
ExtensionAscending = 2 ^ 2
ExtensionDescending = 2 ^ 3
TimeAscending = 2 ^ 4
TimeDescending = 2 ^ 5
SizeAscending = 2 ^ 6
SizeDescending = 2 ^ 7
DirectoriesFirst = 2 ^ 8
DirectoriesLast = 2 ^ 9
End Enum
Public Enum TimeField
Default = 0
Creation = 1
LastAccess = 2
LastWritten = 3
End Enum
Private mPath As String
Private mSort As SortOrder
Private mAttribs As FileAttributes
Private mTime As TimeField
Private mRecurse As Boolean
Private mShort As Boolean
Private Const BASE_COMMAND = "cmd /c dir "
Properties: I'm not sure if I like the "flag" properties as Let
and Get
. Add*Flag
, Has*Flag
, and Remove*Flag
might be better. Opinions are obviously welcome.FilePath
is read only because it is intended to only be set by the passed parameter to Execute
(and is probably misnamed - again, suggestions are welcome).
Public Property Get FilePath() As String
FilePath = mPath
End Property
Public Property Let SortFlags(ByVal value As SortOrder)
mSort = value
End Property
Public Property Get SortFlags() As SortOrder
SortFlags = mSort
End Property
Public Property Let AttributeFlags(ByVal value As FileAttributes)
mAttribs = value
End Property
Public Property Get AttributeFlags() As FileAttributes
AttributeFlags = mAttribs
End Property
Public Property Let SortTimeField(ByVal value As TimeField)
mTime = value
End Property
Public Property Get SortTimeField() As TimeField
SortTimeField = mTime
End Property
Public Property Let RecurseSubDirectories(ByVal value As Boolean)
mRecurse = value
End Property
Public Property Get RecurseSubDirectories() As Boolean
RecurseSubDirectories = mRecurse
End Property
Public Property Let ShortFileNames(ByVal value As Boolean)
mShort = value
End Property
Public Property Get ShortFileNames() As Boolean
ShortFileNames = mShort
End Property
Internal Functionality: Just a couple of helper functions to convert the enumeration values into the command line options:
Private Function SortArguments() As String
If SortFlags = SortOrder.Default Then
SortArguments = vbNullString
Exit Function
End If
With New Scripting.Dictionary
If mSort And NameAscending Then .Add "n", vbNull
If mSort And NameDescending Then .Add "-n", vbNull
If mSort And ExtensionAscending Then .Add "e", vbNull
If mSort And ExtensionDescending Then .Add "-e", vbNull
If mSort And TimeAscending Then .Add "d", vbNull
If mSort And TimeDescending Then .Add "-d", vbNull
If mSort And SizeAscending Then .Add "s", vbNull
If mSort And SizeDescending Then .Add "-s", vbNull
If mSort And DirectoriesFirst Then .Add "g", vbNull
If mSort And DirectoriesLast Then .Add "-g", vbNull
SortArguments = " /o:" & Join(.Keys, vbNullString)
End With
End Function
Private Function AttributeArguments() As String
If AttributeFlags = SortOrder.Default Then
AttributeArguments = vbNullString
Exit Function
End If
With New Scripting.Dictionary
If mAttribs And HiddenFiles Then .Add "h", vbNull
If mAttribs And NonHiddenFiles Then .Add "-h", vbNull
If mAttribs And SystemFiles Then .Add "s", vbNull
If mAttribs And NonSystemFiles Then .Add "-s", vbNull
If mAttribs And DirectoriesOnly Then .Add "d", vbNull
If mAttribs And FilesOnly Then .Add "-d", vbNull
If mAttribs And ArchiveReady Then .Add "a", vbNull
If mAttribs And NonArchiveReady Then .Add "-a", vbNull
If mAttribs And ReadOnly Then .Add "r", vbNull
If mAttribs And NonReadOnly Then .Add "-r", vbNull
AttributeArguments = " /a:" & Join(.Keys, vbNullString)
End With
End Function
Private Function TimeArgument() As String
Select Case SortTimeField
Case TimeField.Default
TimeArgument = vbNullString
Case Creation
TimeArgument = " /t:c"
Case LastAccess
TimeArgument = " /t:a"
Case LastWritten
TimeArgument = " /t:w"
End Select
End Function
The Sole Method: When passed a file path, it performs a dir
on it. Supports ?
and *
wildcards:
Public Function Execute(ByVal dirPath As String) As String()
mPath = dirPath
Dim command As String
command = BASE_COMMAND & """" & dirPath & """ /b " & SortArguments & _
AttributeArguments & TimeArgument
If mRecurse Then command = command & " /s"
If mShort Then command = command & " /x"
With CreateObject("WScript.Shell")
With .Exec(command).StdOut
Dim output As String
Dim arrayBound As Long
Dim results() As String
results = Split(vbNullString)
Do While Not .AtEndOfStream
output = .ReadLine
If output <> vbNullString Then
arrayBound = UBound(results) + 1
ReDim Preserve results(arrayBound)
results(arrayBound) = output
End If
Loop
End With
End With
Execute = results
End Function
Usage example:
'Displays all System32 .dll files in descending order by creation time.
With New DirectoryListing
.SortFlags = TimeDescending
.AttributeFlags = FilesOnly
Dim result() As String
result = .Execute("C:\Windows\System32\*.dll")
Dim i As Long
For i = LBound(result) To UBound(result)
Debug.Print result(i)
Next i
End With