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. In the meantime, for office files that are not read-only, the solution by Microsoft will probably suffice.

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:

0100101₂ = 37₁₀ = vbArchive + vbSystem + vbReadOnly
0000100₂ = 4₁₀ = vbSystem
_______
0000100₂ = 4₁₀, 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

External Links

Macro Code to Check Whether a File Is Already Open : A Microsoft support article (KB138621)

This article is issued from Wikibooks. The text is licensed under Creative Commons - Attribution - Sharealike. Additional terms may apply for the media files.