[VB6] Cambiare attributi ad una cartella

[ghiboz]

e a tutti i files all'interno..
come posso fare???
x i files uso SetAttr nomefile, vbNormal

ma x le cartelle???

questo perchè succede perchè poi uso MoveFolder e sembra che se il file è readonly, crea problemi..

tnx!

[LMondi]

Ciao ghiboz,
vedi se questa Sub fa il caso tuo:

Sub ScanFolders(Path As Variant)

    Dim FSO As New FileSystemObject
    Dim BASEPATH As Folder
    Dim FLD As Folder
    Dim FIL As File
    Dim strSx As String
    Dim MySubDir As String
    Dim FileWayCopy As String
    Dim MyFile As Long
    
    Set BASEPATH = FSO.GetFolder(Path)

    For Each FLD In BASEPATH.SubFolders
        ScanFolders FLD.Path
        'Acquisisce il Nome delle Cartelle:
        strSx = FLD.Name
        ' Percorso completo della SubCartella:
        MySubDir = FLD.Path
        
        For Each FIL In FLD.Files
            DoEvents
            'Percorso completo del file da copiare:
            FileWayCopy = FIL
            'Acquisisce il valore dell'attributo dei files:
            MyFile = GetAttr(FileWayCopy)
            'verifica il valore dell'attributo:
                If (MyFile > 32 And MyFile <> 38) Or MyFile = 1 Then
                    'Toglie l'attributo di sola lettura:
                    SetAttr FileWayCopy, GetAttr(FileWayCopy) And &HFFFE
                    'Conta il n° delle Cartelle:
                    intRisc = intRisc + 1
                    'Espone il Nome delle Cartelle:
                    strSx3 = strSx3 & "   " & FIL
                    strSx3 = strSx3 & vbCrLf
                End If
        Next FIL
            DoEvents
    Next FLD
End Sub

'Sub per togliere il Flag Read Only dalla cartella d'Origine:
Sub ScanFolders2(Path As Variant)

    Dim FSO As New FileSystemObject
    Dim BASEPATH2 As Folder
    Dim FLD2 As Folder
    Dim FIL2 As File
    Dim strSx2 As String
    Dim MySubDir2 As String
    Dim FileWayCopy2 As String
    Dim MyFile2 As Long
    
    Set BASEPATH2 = FSO.GetFolder(Path)

    For Each FLD2 In BASEPATH2.SubFolders
        ScanFolders2 FLD2.Path
        'Acquisisce il Nome delle Cartelle:
        strSx2 = FLD2.Name
        ' Percorso completo della SubCartella:
        MySubDir2 = FLD2.Path
        
        For Each FIL2 In FLD2.Files
            DoEvents
            'Percorso completo del file da copiare:
            FileWayCopy2 = FIL2
            'Acquisisce il valore dell'attributo dei files:
            MyFile2 = GetAttr(FileWayCopy2)
            'verifica il valore dell'attributo:
                If (MyFile2 > 32 And MyFile2 <> 38) Or MyFile2 = 1 Then
                    'Toglie l'attributo di sola lettura:
                    SetAttr FileWayCopy2, GetAttr(FileWayCopy2) And &HFFFE
                    'Conta il n° delle Cartelle:
                    intRisc2 = intRisc2 + 1
                    'Espone il Nome delle Cartelle:
                    strSx4 = strSx4 & "   " & FIL2
                    strSx4 = strSx4 & vbCrLf
                End If
        Next FIL2
            DoEvents
    Next FLD2
End Sub

P.S. Spero che sia per VB6!

[MdE2005]

Ciao ghiboz e LMondi..si, il codice è per visual basic 6 cmq a prima vista non mi sembra adattissimo alle esigenze dell'utente: deve usare le funzioni API GetFileAttributes per ricavare le informazioni sui file e per settarle la funzione SetFileAttributes.
Ti consiglio di provare, se poi non ti riesce qualcosa interverrò io o qualcun altro..

ciao

[LMondi]

Sono due Sub in uso in un programma ... e funzionano benissimo nella copia di files e cartelle appunto nel caso che siano protette da readonly.

[MdE2005]

Ciao..mi scuso con LMondi e con ghiboz in quanto non avevo letto attentamente ma superficialmente il post iniziale:

1) il codice di LMondi è ok
2) per cambiare le proprietà di una cartella occorre usare il FileSystemObject

Dim FSO As FileSystemObject
    Set FSO = New FileSystemObject
    Dim Get_fd As Variant
    Set get_fd = FSO.GetFolder(percorso)
    Get_Fd.attributes = 48 'qui devi inserire un numero, ad esempio
'16, 8 ecc..: ad ogni numero corrisponde una proprietà; ti mando quindi alla guida MSDN per vedere a cosa corrispondono

Ciao

[ghiboz]

grazie a tutti x le risposte!!!

[LMondi]

Spero che funzioni anche per le tue esigenze; per dare a Cesare quello che è di Cesare, devo precisare che le Sub le ho sviluppate su un'informazione di base fornita a suo tempo da Oregon.