VBA Tips - Alterando as propriedades dos arquivos e pastas - Setting File & Folder Attributes - Scripting Runtime object library - Scrrun.dll

Termo de Responsabilidade 

O objeto File e o objeto Folder posseum propriedades de atributo que podem ser usadas para ler ou definir seus respectivos atributos.

Function ChangeFileAttributes(strPath As String, _

                            Optional lngSetAttr As FileAttribute, _

                            Optional lngRemoveAttr As FileAttribute, _

                            Optional blnRecursive As Boolean) As Boolean

   

   ' This function takes a directory path, a value specifying file

   ' attributes to be set, a value specifying file attributes to be

   ' removed, and a flag that indicates whether it should be called

   ' recursively. It returns True unless an error occurs.

   

   Dim fsoSysObj      As FileSystemObject

   Dim fdrFolder      As Folder

   Dim fdrSubFolder   As Folder

   Dim filFile        As File

   

   ' Return new FileSystemObject.

   Set fsoSysObj = New FileSystemObject

   

   On Error Resume Next

   ' Get folder.

   Set fdrFolder = fsoSysObj.GetFolder(strPath)

   If Err <> 0 Then

      ' Incorrect path.

      

Let ChangeFileAttributes = False

      GoTo ChangeFileAttributes_End

   End If

   On Error GoTo 0

   

   ' If caller passed in attribute to set, set for all.

   If lngSetAttr Then

      For Each filFile In fdrFolder.Files

         If Not (filFile.Attributes And lngSetAttr) Then

            

Let filFile.Attributes = filFile.Attributes Or lngSetAttr

         End If

      Next

   End If

   

   ' If caller passed in attribute to remove, remove for all.

   If lngRemoveAttr Then

      For Each filFile In fdrFolder.Files

         If (filFile.Attributes And lngRemoveAttr) Then

            Let filFile.Attributes = filFile.Attributes - lngRemoveAttr

         End If

      Next

   End If

   

   ' If caller has set blnRecursive argument to True, then call

   ' function recursively.

   If blnRecursive Then

      ' Loop through subfolders.

      For Each fdrSubFolder In fdrFolder.SubFolders

         ' Call function with subfolder path.

         ChangeFileAttributes fdrSubFolder.Path, lngSetAttr, lngRemoveAttr, True

      Next

   End If

   

   Let ChangeFileAttributes = True

ChangeFileAttributes_End:

   Exit Function

End Function

A função ChangeFileAttributes leva quatro argumentos: o caminho para uma pasta, uma constante opcional que especifica os atributos para definir, uma constante opcional que especifica os atributos de remover, e um argumento opcional que especifica se a função deve ser chamado recursivamente.

Se o caminho da pasta passado for válido, o procedimento retorna um objeto Folder. Em seguida, ele verifica se o argumento lngSetAttr foi fornecido. Se assim for, ele percorre todos os arquivos na pasta, acrescentando-lhes o novo atributo a todos os arquivos existentes. Utiliza o argumento lngRemoveAttr, removendo os atributos especificados se eles existirem para os arquivos da coleção.

Finalmente, o procedimento verifica se o argumento blnRecursive foi definido como True. Se assim for, chama o procedimento para cada arquivo em cada subpasta do argumento strPath.

Tags: VBA, Tips, files, directory, folder, Scripting Runtime object library, Scrrun.dll, FileSystemObject, GetFiles, ChangeFileAttributes, 

André Luiz Bernardes

bernardess@gmail.com