Esto lo que hace es proteger un directorio o carpeta. Si abres el Explorador el directorio aparece, pero al hacer clic en él no muestra los archivos que contiene. O sea, debería titularlo "ocultar archivos de una carpeta".
Código:Option Explicit Private Type BrowseInfo hWndOwner As Long pIDLRoot As Long pszDisplayName As Long lpszTitle As Long ulFlags As Long lpfnCallback As Long lParam As Long iImage As Long End Type Private Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long Private Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long Dim sPath As String Dim FSO As New FileSystemObject Dim sDir As Folder ' Proyecto -> Referencias = Microsoft Scripting Runtime Private Sub Form_Load() cmdSeleccionar.Caption = "Selecciona carpeta" cmdProteger.Caption = "Proteger carpeta" cmdDesproteger.Caption = "Desproteger carpeta" End Sub Private Sub cmdSeleccionar_Click() Dim lRet As Long Dim BrI As BrowseInfo lRet = SHBrowseForFolder(BrI) If lRet Then sPath = String$(255, 0) SHGetPathFromIDList lRet, sPath If InStr(sPath, vbNullChar) <> 0 Then sPath = Left(sPath, InStr(sPath, vbNullChar) - 1) End If End If Text1 = sPath If InStr(1, sPath, "{", vbTextCompare) Then ' la carpeta se había protegido cmdDesproteger.Enabled = True cmdProteger.Enabled = False Else cmdProteger.Enabled = True cmdDesproteger.Enabled = False End If Text1.SetFocus End Sub Private Sub cmdProteger_Click() Dim sExt As String sExt = ".{FC9FB64A-1EB2-4CCF-AF5E-1A497A9B5C2D}" ' aparece la carpeta, pero sin archivos On Error GoTo hErr FSO.MoveFolder sPath, sPath & ".{FC9FB64A-1EB2-4CCF-AF5E-1A497A9B5C2D}" Set sDir = FSO.GetFolder(sPath & ".{FC9FB64A-1EB2-4CCF-AF5E-1A497A9B5C2D}") sDir.Attributes = Hidden MsgBox "Carpeta protegida.", vbApplicationModal + vbInformation Exit Sub hErr: ' Ten en cuenta que algunas carpetas no se pueden proteger ' p.e. Windows, Mis Documentos o el Directorio actual MsgBox "La carpeta " & sPath & " No se puede proteger.", vbApplicationModal + vbInformation cmdProteger.Enabled = False cmdSeleccionar.SetFocus End Sub Private Sub cmdDesproteger_Click() FSO.MoveFolder sPath, Left(sPath, InStr(sPath, ".{") - 1) Set sDir = FSO.GetFolder(Left(sPath, InStr(sPath, ".{") - 1)) sDir.Attributes = Normal MsgBox "Eliminada la protección.", vbApplicationModal + vbInformation Text1 = "" End Sub
Como siempre, es susceptible de mejoras, si a alguién se le ocurre alguna, sería bueno que lo indicara.
Saludos