Zmiana atrybutu pliku   strona główna:
A po co ten Excel ;-)
 
Zadaniem na dziś będzie ustalenie jakie atrybuty posiada pliki i jak je zmienić.  
     Głównym zadaniem jaki przyświecało idei zajęciem się tym zadaniem była zmiana atrybutu ukryty plików xls w danym folderze.  
Propozycję rozwiązań oparłem o właściwość .Attributes pliku (Obiektu Scripting.File). Jednak właściwość ta nie powie nam "wprost"   Attributes Property
czy plik jest ukryty. Jeżeli chcielibyśmy odczytać wartość tej właściwości zwróci ona liczbę będącą sumą wszystkich nadanych  
plikowi atrybutów. Wartość ta jest więc sumą składającą się z kombinacji wartości zaprezentowanych w poniższym zestawieniu.  
 
    Normal     0   Normal file.              No attributes are set.  
    ReadOnly   1   Read-only file.                      read/write.  
    Hidden     2   Hidden file.                         read/write.  
    System     4   System file.                         read/write.  
    Volume     8   Disk drive volume label.             read-only.  
    Directory  16  Folder or directory.                 read-only.  
    Archive    32  File has changed since last backup.  read/write.  
    Alias      64  Link or shortcut.                    read-only.  
    Compressed 128 Compressed file.                     read-only.  
 
Kolejne wartości każdego atrybutów to i^2 przez co jednoznacznie można odczytać które wartości składają się na sumę.  
Np.: Jeżeli .Attributes pliku zwraca 35 oznacza to że jest to Archive + Hidden + ReadOnly :-)  
    Nasze zadanie zatem będzie polegało na sprawdzeniu czy na .Attributes składa się wartość Hidden :-)  
 
Jednak zrobimy to bardziej kompleksowo :-)  
 
Option Explicit  
 
Type fileAttr  
    bReadOnly   As Boolean  
    bHidden     As Boolean  
    bSystem     As Boolean  
    bVolume     As Boolean  
    bDirectiry  As Boolean  
    bArchive    As Boolean  
    bAlias      As Boolean  
    bCompressed As Boolean  
End Type  
 
Function FileAttributes(objFSOFile As Object) As fileAttr  
    Dim i As Integer, lngAttr As Long  
      
    '----------.Attributes Property (FSO)---------  
    'Normal     0   Normal file. No attributes are set.  
    'ReadOnly   1   Read-only file.             read/write.  
    'Hidden     2   Hidden file.                read/write.  
    'System     4   System file.                read/write.  
    'Volume     8   Disk drive volume label.    read-only.  
    'Directory  16  Folder or directory.        read-only.  
    'Archive    32  File has changed since last backup. read/write.  
    'Alias      64  Link or shortcut.   read-only.  
    'Compressed 128 Compressed file.    read-only.  
      
    With objFSOFile  
        lngAttr = .Attributes  
        For i = 7 To 0 Step -1  
            If lngAttr >= 2 ^ i Then  
                Select Case 2 ^ i  
                    Case 1:   FileAttributes.bReadOnly = True  
                    Case 2:   FileAttributes.bHidden = True  
                    Case 4:   FileAttributes.bSystem = True  
                    Case 8:   FileAttributes.bVolume = True  
                    Case 16:  FileAttributes.bDirectiry = True  
                    Case 32:  FileAttributes.bArchive = True  
                    Case 64:  FileAttributes.bAlias = True  
                    Case 128: FileAttributes.bCompressed = True  
                End Select  
                lngAttr = lngAttr - 2 ^ i  
                If lngAttr = 0 Then Exit For  
            End If  
        Next  
    End With  
 
End Function  
 
A więc... Utworzymy typ (UDT) który będzie nam przechowywał wartość Boolen'owską dla każdego możliwego Atrybutu.   
Następnie napiszemy funkcję która zwróci właśnie taki typ danych. Czemu tak? Bo zależy mi żeby móc zapisać w procedurze...  
If FileAttributes(objFile).bHidden Then  
rozumiecie... :-) Przecież właśnie najbardziej niewygodną kwestią we właściwości Attributes jest fakt że składa się ona z sumy  
nadanych właściwości i nie można zapytać wprost o dana właściwość. Teraz już można :-)  
 
no i procedura która w wyznaczonym folderze "odkryje" nam ukryte pliki xls.  
 
Sub Start()  
    UkrytePliki ThisWorkbook.Path, "*.xls"  
End Sub  
 
Sub UkrytePliki(strFolderPath As String, _  
                Optional strFileLike As String = "*.*")  
                  
    Dim objFSO As Object 'Scripting.FileSystemObject  
    Dim objFolder As Object 'Scripting.Folder  
    Dim objFile As Object 'Scripting.File  
 
    Const Hidden = 2  
 
    Set objFSO = CreateObject("Scripting.FileSystemObject")  
    Set objFolder = objFSO.GetFolder(strFolderPath)  
    For Each objFile In objFolder.Files  
        With objFile  
            If .Name Like strFileLike Then  
                If FileAttributes(objFile).bHidden Then .Attributes = .Attributes - Hidden  
            End If  
        End With  
    Next  
    Set objFolder = Nothing  
    Set objFSO = Nothing  
End Sub  
 
Czemu .Attributes = .Attributes - Hidden ??  
   Od początku przyświecała mi idea żeby nie ruszać innych atrybutów zmienianego pliku. Stąd właśnie konieczność odczytania  
wszystkich właściwości. Teraz kiedy już wiemy że .Attributes = 35 to 35 - Hidden = Archive + ReadOnly  :-)  
 
Miłej zabawy :-)  
 
 
 
 Tu inne podejście jednak wymaga założenia innego tematu żeby wyjaśniać linia po linii. Na razie chciałem jednak pokazać że nie jedna droga prowadzi  
do celu :-)  
 
Sub Start2()  
    Dim strFolderPath As String, strFileName As String  
    Dim tbl As Variant, i As Long  
      
    strFolderPath = ThisWorkbook.Path  
      
    tbl = HiddenFiles(strFolderPath, "*.xls")  
    If Not IsEmpty(tbl) Then  
        For i = 0 To UBound(tbl)  
            strFileName = strFolderPath & "\" & tbl(i)  
            SetAttr PathName:=strFolderPath & "\" & tbl(i), _  
                    Attributes:=GetAttr(PathName:=strFileName) - 2  
        Next  
    End If  
      
End Sub  
 
Function HiddenFiles(strFolderName As String, _  
                     Optional strFileLike As String = "*.*") As Variant  
                        
    Dim objShell As Object, strFileName As String  
    Dim arrFileNames() As String, i As Long  
    Set objShell = CreateObject("Wscript.Shell")  
 
    With objShell.Exec("%comspec% /c dir """ & strFolderName & """ /ah /b").StdOut  
        Do While Not .AtEndOfStream  
            strFileName = .ReadLine  
            If strFileName Like strFileLike Then  
                ReDim Preserve arrFileNames(i)  
                arrFileNames(i) = strFileName  
                i = i + 1  
            End If  
        Loop  
    End With  
    If i > 0 Then HiddenFiles = arrFileNames  
    Set objShell = Nothing  
End Function  
 
Sporym atutem metody jest fakt ze nie trzeba przeglądać wszystkich plików w katalogu i wydzielać z każdego pojedyncze atrybuty  
żeby sprawdzić czy plik jest ukryty. Jednak wydaje mi się ze można w niej jeszcze co nieco poprawić... :-)