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:
Uso del objeto del sistema de archivos (FSO) para recuperar los atributos de la carpeta
Aquí hay una función simple para obtener los atributos de una carpeta, como: Archivo de volumen del sistema oculto de solo lectura comprimido y más …
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.