Visual Basic for Applications/File and Folder Utilities

Summary 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 At 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 Option 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 See Also External Links