Microsoft Office 2000/Visual Basic Programmer's Guide |
The File object and Folder object provide an Attributes property that you can use to read or set a file or folder's attributes, as shown in the following example.
The ChangeFileAttributes procedure takes four arguments: the path to a folder, an optional constant that specifies the attributes to set, an optional constant that specifies the attributes to remove, and an optional argument that specifies that the procedure should be called recursively.
If the folder path passed in is valid, the procedure returns a Folder object. It then checks to see if the lngSetAttr argument was provided. If so, it loops through all the files in the folder, appending the new attribute or attributes to each file's existing attributes. It does the same for the lngRemoveAttr argument, except in this case it removes the specified attributes if they exist for files in the collection.
Finally, the procedure checks whether the blnRecursive argument has been set to True. If so, it calls the procedure for each file in each subfolder of the strPath argument.
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.
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
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
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
ChangeFileAttributes = True
ChangeFileAttributes_End:
Exit Function
End Function
Both of these procedures are available in the modFiles module in VBA.mdb in the ODETools\V9\Samples\OPG\Samples\CH07 subfolder on the Office 2000 Developer CD-ROM.