Ciao ghiboz,
vedi se questa Sub fa il caso tuo:
codice:
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
codice:
'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!