Access

Uso del objeto del sistema de archivos (FSO) para verificar si una carpeta tiene un atributo

Después de la publicación de ayer sobre la enumeración de los atributos de una carpeta:

Pensé en compartir otra variación en esa función, una función para probar si se establece un atributo específico para una carpeta.

Para simplificar las cosas para la codificación para que no tengamos que recordar los valores numéricos de los diversos atributos, comienzo creando una enumación que usamos al llamar a la función.

Public Enum FolderAttribute
    Normal = 0
    ReadOnly = 1
    Hidden = 2
    System = 4
    Volume = 8
    Directory = 16
    Archive = 32
    Alias = 1024
    Compressed = 2048
End Enum

'---------------------------------------------------------------------------------------
' Procedure : FSO_FolderHasAttribute
' Author    : Daniel Pineault, CARDA Consultants Inc.
' Website   : 
' Purpose   : Check if a folder has the specified attribute set
' Copyright : The following is release as Attribution-ShareAlike 4.0 International
'             (CC BY-SA 4.0) - 
' Req'd Refs: Late Binding  -> None required
'             Early Binding -> Microsoft Scripting Runtime
'Dependencies: FolderAttribute Enum
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' sFolderPath   : Path of the folder you wish to check the attribute of
' lAttrToCheck  : Attribute to validate the presence of
'
' Usage:
' ~~~~~~
' ? FSO_FolderHasAttribute("C:\Config.Msi\", readonly)
'       Returns -> True
'
' ? FSO_FolderHasAttribute("C:\Windows", readonly)
'       Returns -> False
'
' ? FSO_FolderHasAttribute("C:\System Volume Information", FolderAttribute.System)
'       Returns -> True
'
' Revision History:
' Rev       Date(yyyy-mm-dd)        Description
' **************************************************************************************
' 1         2022-01-31
' 2         2025-01-30              Updated header to new format
'                                   Renamed function to follow conversion
'                                   Added Early/Late binding CCD
'---------------------------------------------------------------------------------------
Public Function FSO_FolderHasAttribute(ByVal sFolderPath As String, _
                                       ByVal lAttrToCheck As FolderAttribute) As Boolean
    #Const FSO_EarlyBind = False    'True => Early Binding / False => Late Binding
    #If FSO_EarlyBind = True Then
        Dim oFSO              As Scripting.FileSystemObject
        Dim oFolder           As Scripting.folder

        Set oFSO = New FileSystemObject
    #Else
        Dim oFSO              As Object
        Dim oFolder           As Object

        Set oFSO = CreateObject("Scripting.FileSystemObject")
    #End If

    On Error GoTo Error_Handler

    'Add validation of the input lAttrToCheck value ???

    If oFSO.FolderExists(sFolderPath) Then
        Set oFolder = oFSO.GetFolder(sFolderPath)
        FSO_FolderHasAttribute = (oFolder.Attributes And lAttrToCheck) = lAttrToCheck
    End If

Error_Handler_Exit:
    On Error Resume Next
    Set oFolder = Nothing
    Set oFSO = Nothing
    Exit Function

Error_Handler:
    MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
           "Error Source: FSO_FolderHasAttribute" & vbCrLf & _
           "Error Number: " & Err.Number & vbCrLf & _
           "Error Description: " & Err.Description & _
           Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
           , vbOKOnly + vbCritical, "An Error has Occurred!"
    Resume Error_Handler_Exit
End Function

Luego, para usar lo anterior, como se muestra en la sección de uso del cartucho de encabezado de función, solo necesitamos hacer:

Debug.Print FSO_FolderHasAttribute("C:\Windows", readonly)

que debería regresar

False

Y

Debug.Print FSO_FolderHasAttribute("C:\System Volume Information", FolderAttribute.System)

que debería regresar

True

Así que ahí lo tienes, una rutina más simple para ayudar cuando se trabaja con carpetas.

Publicaciones relacionadas

Deja una respuesta

Tu dirección de correo electrónico no será publicada. Los campos obligatorios están marcados con *

Botón volver arriba