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:

• De solo lectura
• Oculto
• Sistema
• Volumen
• Archivo
• Comprimido
• Y más …

'---------------------------------------------------------------------------------------
' Procedure : FSO_GetoFolderAttributes
' Author    : Daniel Pineault, CARDA Consultants Inc.
' Website   : 
' Purpose   : List the attributes of the specified folder
' 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
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' sFolderPath   : Path of the folder you wish to check the attributes of
' sDelimiter    : Delimiter to be used to separate the attributes, default to a comma
'
' Usage:
' ~~~~~~
' ? FSO_GetoFolderAttributes("C:\MSOCache")
'   Returns -> ReadOnly, Hidden, Directory
'
' ? FSO_GetoFolderAttributes("C:\Windows")
'   Returns -> Directory
'
' ? FSO_GetoFolderAttributes("C:\System Volume Information")
'   Returns -> Hidden, System, Directory
'
' Revision History:
' Rev       Date(yyyy-mm-dd)        Description
' **************************************************************************************
' 1         2009-07-23
' 2         2025-01-30              Updated header to new format
'                                   Renamed function to follow conversion
'                                   Added new constants
'                                   Added Early/Late binding CCD
'---------------------------------------------------------------------------------------
Function FSO_GetoFolderAttributes(ByVal sFolderPath As String, _
                                  Optional sDelimiter As String = ", ") As String
    #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
    Dim sOutput               As String

    On Error GoTo Error_Handler

    If oFSO.FolderExists(sFolderPath) Then
        Set oFolder = oFSO.GetFolder(sFolderPath)

        If oFolder.Attributes And 1 Then sOutput = sOutput & "Read-Only" & sDelimiter    'FSO
        If oFolder.Attributes And 2 Then sOutput = sOutput & "Hidden" & sDelimiter    'FSO
        If oFolder.Attributes And 4 Then sOutput = sOutput & "System" & sDelimiter    'FSO
        If oFolder.Attributes And 8 Then sOutput = sOutput & "Volume" & sDelimiter    'FSO
        If oFolder.Attributes And 16 Then sOutput = sOutput & "Directory" & sDelimiter    'FSO
        If oFolder.Attributes And 32 Then sOutput = sOutput & "Archive" & sDelimiter    'FSO
        If oFolder.Attributes And 1024 Then sOutput = sOutput & "Alias" & sDelimiter    'FSO
        'If oFolder.attributes And 1024 Then sOutput = sOutput & "ReparsePoint" & sDelimiter 'File Attribute Const?
        If oFolder.Attributes And 2048 Then sOutput = sOutput & "Compressed" & sDelimiter    'FSO
        'If oFolder.Attributes And 8192 Then sOutput = sOutput & "NotContentIndexed" & sDelimiter    'File Attribute Const?
        'If oFolder.Attributes And 16384 Then sOutput = sOutput & "Encrypted" & sDelimiter    'File Attribute Const?
        'If oFolder.Attributes And 32768 Then sOutput = sOutput & "Integrity Stream" & sDelimiter    'File Attribute Const?
        'If oFolder.Attributes And 524288 Then sOutput = sOutput & "Pinned" & sDelimiter    'File Attribute Const?
        'If oFolder.Attributes And 1048576 Then sOutput = sOutput & "Unpinned" & sDelimiter    'File Attribute Const?

        If sOutput = "" Then
            sOutput = "Normal"
        Else
            sOutput = Left(sOutput, Len(sOutput) - Len(sDelimiter))    ' Remove the trailing delimiter
        End If
    Else
        sOutput = "'" & sFolderPath & "' does not exist"
    End If

    FSO_GetoFolderAttributes = sOutput

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_GetoFolderAttributes" & 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

Para obtener más información sobre el tema, asegúrese de consultar la documentación oficial en:

Propiedad de atributos (Visual Basic para aplicaciones)

Tema de referencia de VBA de la oficina

File Atribute Constants (Winnt.h) – Aplicaciones Win32

Los atributos de archivo son valores de metadatos almacenados por el sistema de archivos en el disco y están utilizados por el sistema y están disponibles para los desarrolladores a través de varias API de E/S de archivos.