Results 1 to 8 of 8
  1. #1
    Join Date
    Dec 2003
    Location
    WA, USA
    Posts
    51

    Cool Unanswered: Change Directry Attributes W/VB

    Does anyone out there know how I can programmatically change the attributes of a directory?

    I have a program that searches for a specified file and returns the path given a starting directory but it wont look into directories that are read only.

    Some of the directories I'm finding (i.e. Program Files) are flagged as read only. And I need to be able to search in these as well.

    I'm up for other suggestions as well.

    Thanks
    Bob

  2. #2
    Join Date
    Nov 2003
    Location
    Warren, PA
    Posts
    52
    Shell "attrib D:\*.* -r /s"


    Brent

  3. #3
    Join Date
    Oct 2003
    Location
    Ger
    Posts
    1,969
    Provided Answers: 1
    Try to use

    FileSystem.SetAttr

  4. #4
    Join Date
    Nov 2003
    Posts
    1,487
    Here is a little bit of code for you to play with.....

    SetAllFileAttributes (and folders if you want)
    Code:
    Public Function SetAllFileAttributes(PathStrg As String, FAttr As Integer, Optional IncludeFolder As Boolean) As Integer
         ‘THE VARIOUS ATTRIBUTES
         ‘====================
         ‘0 is Normal (default)
         ‘1 is Read-only
         ‘2 is Hidden
         ‘4 is System file
         ’32 is Archive
         ‘The IncludeFolder will only come into effect if FAttr is not 4 (System).
    
         If Right$(PathStrg, 1) <> "\" Then PathStrg = PathStrg & "\"
                On Error Resume Next	‘Trap any errors.
                Dim a$
                ‘The parameter number 14 tells the DIR function (below) to look
                ‘for all files no matter what their current attributes may be.
                a$ = Dir(PathStrg & "*.*", 14) 
                If a$ <> "" Then SetAttr PathStrg & a$, Fattr
                Do Until a$ = “”
    	a$ = Dir
    	If a$ <> “” Then SetAttr PathStrg & a$, FAttr
                Loop
                If IncludeFolder = True And FAttr <> 4 Then SetAttr Left$(PathStrg, Len(PathStrg) - 1), FAttr
                If err = 0 Then SetAllFileAttributes = 1
    End Function
    How To Use SetAllFileAttributes
    Code:
    	
     ‘Int = SetAllFileAttributes ([String - Path] , [Integer - FileAttribute], [Optional Boolean - ChangeFolderAttrAsWell]
    
        ‘THE VARIOUS ATTRIBUTES
        ‘====================
        ‘0 is Normal (default)
        ‘1 is Read-only
        ‘2 is Hidden
        ‘4 is System file
        ’32 is Archive
        
        ‘Set the attribute for ALL files contained within the provided path.
      
        ‘ie:  SetAllFileAttributes [Path] , [file Attribute], [change folder attribute as well – True/False]
    
        ‘Set the attribute for the current folder at end of path as well.	
        If SetAllFileAttributes("C:\MyPath\MyPath1\MyPath2", 0, True) = 1 Then
            MsgBox "All files (and folder) attributes have been changed.”
        End If
    
       ‘Do Not set the attribute for the current folder at end of path.	
        If SetAllFileAttributes("C:\MyPath\MyPath1\MyPath2", 0, False) = 1 Then
            MsgBox "All file attributes have been changed for files in the provided path.”
        End If
    GetFolderAttributes
    Code:
    Public Function GetFolderAttributes (PathStrg As String) As Integer
         ‘If an error occures during the process Then a -1 is returned.
         On Error Resume Next	
         PathStrg = Trim(PathStrg)
         If Right$(PathStrg, 1) = "\" Then PathStrg = Left$(PathStrg, Len(PathStrg) - 1)
         GetFolderAttributes = GetAttr(PathStrg)
         If Err Then GetFolderAttributes= -1
    End Function
    GetFolderAttributesString
    Code:
    Public Function GetFolderAttributesString (PathStrg As String) As String
         [CLOR=green]‘If an error occures then a empty string is returned.[/COLOR]
         On Error Resume Next
         Dim x As Integer,a$
         If DoesPathExist (PathStrg) = 0 Then GetFolderAttributesString = “”: Exit Function
         x = GetFolderAttributes(PathStrg)
         Select Case x
              Case 16
                   a$ = “No Attributes”
              Case 17
                   a$ = “Read-Only”
              Case 18
                   a$ = “Hidden”
              Case 19 
                   a$ = “Read-Only - Hidden”
              Case 20
                   a$ = “System”
              Case 21
                   a$ = “Read-Only - System”
              Case 22
                   a$ = “Hidden - System”
              Case 23 
                   a$ = “Read-Only – Hidden - System”
              Case 48
                   a$ = “Archive”
              Case 49 
                   a$ = “Read-Only - Archive”
              Case 50
                   a$ = “Hidden - Archive”
              Case 51
                   a$ = “Read-Only – Hidden - Archive”
              Case 55 
                   a$ = “Read-Only – Hidden – System - Archive”
         End Select
         If Err <> 0 Then 
              GetFolderAttributesString = “” 
         Else 
              GetFolderAttributesString = a$
         End If	
    End Function
    GetFileAttributes
    Code:
    Public Function GetFileAttributes (PathStrg As String) As Integer
         ‘If an error occures during the process Then a -1 is returned.
         On Error Resume Next	
         PathStrg = Trim(PathStrg)
         GetFileAttributes = GetAttr(PathStrg)
         If Err Then GetFileAttributes= -1
    End Function
    GetFileAttributesString
    Code:
    Public Function GetFileAttributesString (PathStrg As String) As String
         ‘If an error occures then a empty string is returned.
         On Error Resume Next
         Dim x As Integer, a$
         If DoesFileExist (PathStrg) = 0 Then GetFileAttributesString = “”: Exit Function
         x = GetFileAttributes(PathStrg)
         Select Case x
             Case 0
                 a$ = “No Attributes”
             Case 1
                 a$ = “Read-Only”
             Case 2
                 a$ = “Hidden”
             Case 3
                 a$ = “Read-Only - Hidden”
             Case 4
                 a$ = “System”
             Case 5
                 a$ = “Read-Only - System”
             Case 6
                 a$ = “Hidden - System”
             Case 7
                 a$ = “Read-Only – Hidden - System”
             Case 32
                 a$ = “Archive”
             Case 33
                 a$ = “Read-Only - Archive”
             Case 34
                 a$ = “Hidden - Archive”
             Case 35
                 a$ = “Read-Only – Hidden - Archive”
             Case 39 
                 a$ = “Read-Only – Hidden – System - Archive”
         End Select
         If Err <> 0 Then 
            GetFileAttibutesString = “”
         Else
            GetFileAttributesString = a$
         End If
    End Function
    DoesFileExist
    Code:
    Public Function DoesFileExist(PathStrg As String) As Integer
         Dim a$
         On Error Resume Next
         a$ = Dir(PathStrg, 14)
         If a$ <> ”” And Err =0 Then DoesFileExist = 1
    End Function
    Just a few things to play with.

  5. #5
    Join Date
    Oct 2003
    Location
    Ger
    Posts
    1,969
    Provided Answers: 1

    Smile

    Thank you, that is very nice code and you can make anc check much with it.


  6. #6
    Join Date
    Oct 2003
    Location
    Ger
    Posts
    1,969
    Provided Answers: 1
    Hello SyberLynx,

    Does the function DoesPathExist has the same construction like the function DoesFileExist ?

  7. #7
    Join Date
    Dec 2003
    Location
    WA, USA
    Posts
    51

    Cool

    SyberLynx, Thanks a lot! That looks great and I will give it a try today.
    Bob

  8. #8
    Join Date
    Nov 2003
    Posts
    1,487
    Good eye Hammbakka........thank you. The function DoesPathExist is indeed somewhat different from DoesFileExist. Sorry folks, I guess I missed posting that one. Here it is...

    Code:
    DoesPathExist
    
    ‘This function will determine if the provided path (including drive)
    ‘in the PathStrg string variable actually exists. Returns a 0 if the
    ‘path does not exist and a 1 if it does.
    
    Public Function DoesPathExist(PathStrg As String) As Integer
        On Error Resume Next
        If Right$(PathStrg, 1) <> "\" Then PathStrg = PathStrg & "\"
        Dim a$
        a$ = Dir(PathStrg,vbDirectory)
        If a$ <> ”” And Err = 0 Then DoesPathExist = 1
    End Function
    Once again.....sorry about that and Thank You Hammbakka for picking up on that.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •