5
\$\begingroup\$

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 for dir.
  • 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 to True or False (just like dir, 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
asked Sep 1, 2016 at 4:50
\$\endgroup\$
1
  • 1
    \$\begingroup\$ This is going to be so useful. \$\endgroup\$ Commented Sep 1, 2016 at 8:18

1 Answer 1

2
\$\begingroup\$
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.

answered Sep 2, 2016 at 23:01
\$\endgroup\$
2
  • 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\$ Commented 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 of AddFlags would be. Take it with a grain of salt though, I've been spending my time bit-twiddling register values on a microcontroller lately. The AddFlag methods may be easier for average joe VBA dev to grok. \$\endgroup\$ Commented Sep 3, 2016 at 11:43

Your Answer

Draft saved
Draft discarded

Sign up or log in

Sign up using Google
Sign up using Email and Password

Post as a guest

Required, but never shown

Post as a guest

Required, but never shown

By clicking "Post Your Answer", you agree to our terms of service and acknowledge you have read our privacy policy.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.