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
-
1\$\begingroup\$ This is going to be so useful. \$\endgroup\$Kaz– Kaz2016年09月01日 08:18:17 +00:00Commented Sep 1, 2016 at 8:18
1 Answer 1
Private Const BASE_COMMAND = "cmd /c dir "
The constant declaration doesn't have an explicit type; this would trigger an inspection result with Rubberduck; applying thhe quickfix would turn the declaration into this:
Private Const BASE_COMMAND As String = "cmd /c dir "
It's debatable whether explicitly assigning the return value has any use here:
If SortFlags = SortOrder.Default Then
SortArguments = vbNullString
Exit Function
End If
The result would be the same without the assignment... on the other hand, it's a good practice to have all code paths return a value, be it only for the love of explicitness.
Same here:
If AttributeFlags = SortOrder.Default Then
AttributeArguments = vbNullString
Exit Function
End If
...except there's a minor little copy-pasta error here - SortOrder.Default
should be FileAttributes.Default
! ..but it's no biggie because both values are 0.
The naming of enum types isn't consistent - flag enums should have a plural name:
Public Enum FileAttributes 'correct
Default = 0
HiddenFiles = 2 ^ 0
NonHiddenFiles = 2 ^ 1
SystemFiles = 2 ^ 2
'...
End Enum
Public Enum SortOrder 'how does client code know they can be combined?
Default = 0
NameAscending = 2 ^ 0
NameDescending = 2 ^ 1
ExtensionAscending = 2 ^ 2
'...
End Enum
Public Enum TimeField 'ok
Default = 0
Creation = 1
LastAccess = 2
LastWritten = 3
End Enum
I have no problem with TimeField
or its values. Perhaps better names could be FileAttributeFlags
and SortOrderFlags
for the two flag enum types? I have no neat solution for the mutually exclusive sort flag values though, other than proper validation and error-raising in Property Let SortFlags
.
The TimeField
enum member values don't need to be explicit (they're assigned to the default values anyway).
SortOrder
values come in mutually exclusive pairs, so there should be some validation logic in the Property Let SortFlags
member, to raise an error that tells the client code when it tries to set the NameAscending
flag when NameDescending
is already set.
Public Property Let SortFlags(ByVal value As SortOrder)
ThrowOnConflictingSortFlags value
mSort = value
End Property
Private Sub ThrowOnConflictingSortFlags(ByVal value As SortOrder)
'this is where short-circuiting logical operators would be nice...
If HasFlag(value, NameAscending + NameDescending) Then OnConflictingFlagsError NameAscending, NameDescending
If HasFlag(value, ExtensionAscending + ExtensionDescending) Then OnConflictingFlagsError ExtensionAscending, ExtensionDescending
If HasFlag(value, TimeAscending + TimeDescending) Then OnConflictingFlagsError TimeAscending, TimeDescending
If HasFlag(value, SizeAscending + SizeDescending) Then OnConflictingFlagsError SizeAscending, SizeDescending
If HasFlag(value, DirectoriesFirst, DirectoriesLast) Then OnConflictingFlagsError DirectoriesFirst, DirectoriesLast
End Sub
Private Sub OnConflictingFlagsError(ByVal flag1 As SortOrder, ByVal flag2 As SortOrder)
'something like this could work I guess
Err.Raise 5, TypeName(Me), "Specified sort order flags values " & flag1 & " and " & flag2 & " are mutually exclusive."
End Sub
Private Function HasFlag(ByVal value As Long, ByVal flag As Long) As Boolean
HasFlag = (value And flag) = flag
End Function
Such a HasFlag
function could very well be reused to simplify SortArguments
and AttributeArguments
functions, too.
-
1\$\begingroup\$ Yeah, the naming part of my brain wasn't working when I wrote it... although I always debate myself as to whether flag enums should be plural or singular. The Easter egg copy paste error is still undiscovered... \$\endgroup\$Comintern– Comintern2016年09月02日 23:15:28 +00:00Commented Sep 2, 2016 at 23:15
-
\$\begingroup\$ @Comintern I would consider making Mug's
HasFlag
a public "static" method, maybe move it into a module. I personally like the properties as they are. It makes the code much less verbose than a bunch ofAddFlags
would be. Take it with a grain of salt though, I've been spending my time bit-twiddling register values on a microcontroller lately. TheAddFlag
methods may be easier for average joe VBA dev to grok. \$\endgroup\$RubberDuck– RubberDuck2016年09月03日 11:43:00 +00:00Commented Sep 3, 2016 at 11:43