Visual Basic for Applications/File and Folder Utilities
Summary
edit- This first set of utilities concentrates on the basic FileSystemObject set; that is, the set used to find whether or not a file or folder exists, what their sizes are, and whether or not they have a particular attribute. A basic path parsing procedure is also provided. All of these procedures need a reference set in the VBA editor to Microsoft Scripting Runtime
- No universally useful code was found for testing for open files. Although many procedures exist, they all fail in some way, usually failing to identify open text or image files, or Office files that are marked as read-only. The basis of the problem is that many such files in Windows do not lock when opened by a user, so procedures that attempt to detect the open state by trying for sole access, cannot do so. Any reader with a universal solution is, as always, invited to comment.
VBA Notes
editAt times it is useful to know whether or not a file or folder has a particular attribute, for example, to avoid hidden or system files in listings. The procedure HasAttribute does this, taking a path to the file as parameter and a short-code to identify the attribute of interest. However, the attribute bundle is delivered with all of the attribute number values added together, so this type of test, like other enumerations that involve constants (eg; the message box types), makes use of the AND function to split the bundle.
For example: (See procedure HasAttribute below.) Assume that the attribute bundle from GetAttr equals 37
and that we are testing for the "system" attribute only ("S") with vbSystem = 4. Now, for numbers,
the AND operator performs a bitwise AND on each column, so gives:
01001012 = 3710 = vbArchive + vbSystem + vbReadOnly
00001002 = 410 = vbSystem
_______
00001002 = 410, interpreted by boolean variables as True since it is non-zero
That is to say, the "system" attribute is present in the attribute bundle.
If the "system" attribute were not set, then the result would have been all zeros
It is important to note that the returned value tests only one attribute at a time; that is to say, although a file returns true for for read-only ("R"), it might also have other attributes that are not tested. If users would rather have all of the file or folder attributes returned in one string, some work might be done to concatenate the result codes.
An example of file path parsing is given in the ParsePath procedure. The example uses the Split function to place all of the backslash separated terms into an array, then recombines them to make the path. A similar method, split on the dot is used to make the file name and suffix.
VBA Code Module
editOption Explicit
Function FileFound(sPath As String) As Boolean
'returns true if parameter path file found
Dim fs As FileSystemObject
'set ref to fso
Set fs = CreateObject("Scripting.FileSystemObject")
'test for file
FileFound = fs.FileExists(sPath)
Set fs = Nothing
End Function
Function FolderFound(sPath As String) As Boolean
'returns true if parameter path folder found
Dim fs As FileSystemObject
'set ref to fso
Set fs = CreateObject("Scripting.FileSystemObject")
'test for folder
FolderFound = fs.FolderExists(sPath)
Set fs = Nothing
End Function
Function GetFileSize(sPath As String, nSize As Long) As Boolean
'returns file size in bytes for parameter path file
Dim fs As FileSystemObject, f As File
Set fs = CreateObject("Scripting.FileSystemObject")
If fs.FileExists(sPath) Then
Set f = fs.GetFile(sPath)
nSize = f.Size
GetFileSize = True
End If
Set fs = Nothing: Set f = Nothing
End Function
Function GetFolderSize(sPath As String, nSize As Long) As Boolean
'returns total content size in bytes for parameter path folder
Dim fs As FileSystemObject, f As Folder
Set fs = CreateObject("Scripting.FileSystemObject")
If fs.FolderExists(sPath) Then
Set f = fs.GetFolder(sPath)
nSize = f.Size
GetFolderSize = True
End If
Set fs = Nothing: Set f = Nothing
End Function
Function HasAttribute(sPath As String, sA As String) As Boolean
'returns true if parameter path file or folder INCLUDES test parameter
'eg: if sA= "H" then returns true if file attributes INCLUDE "hidden"
'Untested attributes might also exist
'sA values
'"R"; read only, "H"; hidden, "S"; system, "A"; archive
'"D"; directory, "X"; alias, "N"; normal
Dim bF As Boolean, nA As Integer
Dim bFile As Boolean, bFldr As Boolean
Dim fs As FileSystemObject, f As File, fd As Folder
Set fs = CreateObject("Scripting.FileSystemObject")
'check path parameter
bFile = fs.FileExists(sPath)
bFldr = fs.FolderExists(sPath)
If bFile Or bFldr Then
'get its attribute bundle
nA = GetAttr(sPath)
Else
'neither found so exit
MsgBox "Bad path parameter"
GoTo Wayout
End If
'early exit for no attributes
If nA = 0 And sA = "N" Then '0
HasAttribute = True
Exit Function
End If
'test for attribute in sA
'logical AND on number variable bit columns
If (nA And vbReadOnly) And sA = "R" Then '1
bF = True
ElseIf (nA And vbHidden) And sA = "H" Then '2
bF = True
ElseIf (nA And vbSystem) And sA = "S" Then '4
bF = True
ElseIf (nA And vbDirectory) And sA = "D" Then '16
bF = True
ElseIf (nA And vbArchive) And sA = "A" Then '32
bF = True
ElseIf (nA And vbAlias) And sA = "X" Then '64
bF = True
End If
HasAttribute = bF
Wayout:
Set fs = Nothing: Set f = Nothing: Set fd = Nothing
End Function
Function ParsePath(sPath As String, Optional sP As String, _
Optional sF As String, Optional sS As String) As Boolean
'sPath has full file path
'returns path of file with end backslash (sP),
'file name less suffix (sF), and suffix less dot(sS)
Dim vP As Variant, vS As Variant, n As Long
Dim bF As Boolean, fs As FileSystemObject
'set ref to fso
Set fs = CreateObject("Scripting.FileSystemObject")
'test that file exists
bF = fs.FileExists(sPath)
If Not bF Then
'MsgBox "File not found"
GoTo Wayout
End If
'make array from path elements split on backslash
vP = Split(sPath, "\")
'make array from file name elements split on dot
vS = Split(vP(UBound(vP)), ".")
'rebuild path with backslashes
For n = LBound(vP) To UBound(vP) - 1
sP = sP & vP(n) & "\"
Next n
sF = vS(LBound(vS))
sS = vS(UBound(vS))
ParsePath = True
Wayout:
Set fs = Nothing
End Function