Views

...

Important:

Quaisquer soluções e/ou desenvolvimento de aplicações pessoais, ou da empresa, que não constem neste Blog podem ser tratados como consultoria freelance.

E-mails

Deixe seu e-mail para receber atualizações...

eBook Promo

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



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

eBooks VBA na AMAZOM.com.br

LinkWithinBrazilVBAExcelSpecialist

Related Posts Plugin for WordPress, Blogger...

Vitrine