Supprimer un répertoire et tout son contenu (sous-dossiers et fichiers)

Soyez le premier à donner votre avis sur cette source.

Snippet vu 42 693 fois - Téléchargée 38 fois

Commenter

Contenu du snippet

Cette fonction est extrèmement simple. Elle permet de supprimer un dossier et tout son contenu (sous-répertoires et fichiers). La fonction renvoie "True" si le processus de suppression s'est déroulé normalement. Sinon, elle renvoie "False".

Particularités intéressantes :
- Elle permet de supprimer les fichiers et les dossiers qui sont en lecture seule;
- Elle permet de supprimer les fichiers et les dossiers cachés (y compris les fichiers système tels que Thumbs.db, ...).
- Elle permet de supprimer le contenu d'un lecteur.

Limitations :
- Elle ne permet pas la suppression de fichiers en cours d'utilisation;
- Elle ne permet pas la suppression de fichiers et/ou de dossiers en cours de visualisation (dans l'explorateur Windows ou autre).

La fonction est désormais disponible en 3 versions : la première ne permet pas le vidage des dossiers temporaires de Windows, la seconde bien. En fait, la deuxième permet le vidage de dossiers contenant des fichiers en cours d'utilisation. La troisième est une évolution de la seconde qui permet, si on le désire, de ne supprimer que les répertoires vides et les fichiers vides (dont la taille est de 0 octets).

ATTENTION :
- Prenez la peine de lire les remarques !

Pour les débutants :
- Ne copiez, dans votre module ou programme, qu'une des 3 versions de la fonction !

Source / Exemple : 


' Version qui ne permet pas le vidage des dossiers temporaires de Windows :

Public Function SupprimeRépertoire(Répertoire As String) As Boolean
    On Error GoTo Erreur
    Dim SousRépertoire As String
    Dim Val As String
    SousRépertoire = Dir(Répertoire, vbDirectory + vbHidden + vbSystem + vbArchive)
    Do While SousRépertoire <> ""
        If SousRépertoire <> "." And SousRépertoire <> ".." Then
            If (GetAttr(Répertoire & SousRépertoire) And vbDirectory) = vbDirectory Then
                ' C'est un sous-répertoire. Donc, on effectue un appel récursif.
                SupprimeRépertoire (Répertoire & SousRépertoire & "\")
            Else
                ' C'est un fichier. Donc, on concatène le nom du répertoire avec le sien.
                Val = Répertoire & SousRépertoire
                ' On s'assure que le fichier n'est pas en lecture seule.
                SetAttr Val, vbReadOnly = 0
                ' On supprime le fichier.
                Kill (Répertoire & SousRépertoire)
            End If
        End If
        ' Dir peut avoir été appelé, donc on réinitialise le tout.
        SousRépertoire = Dir(Répertoire, vbDirectory + vbHidden + vbSystem + vbArchive)
        ' Pour passer le répertoire courant et le répertoire parent.
        If SousRépertoire = "." Then
          SousRépertoire = Dir
        End If
        If SousRépertoire = ".." Then
          SousRépertoire = Dir
        End If
    Loop
    If ((Right(Répertoire, 2)) <> ":\") Then
        ' Ce n'est pas la racine du disque, donc on supprime après s'être assuré que le répertoire n'est pas en lecture seule.
        SetAttr Répertoire, vbReadOnly = 0
        RmDir Répertoire
    End If
    SupprimeRépertoire = True
    Exit Function
    
Erreur:
    SupprimeRépertoire = False
End Function

' Remarque : Si un fichier ou un dossier ne peut être supprimé parce qu'il est en cours d'utilisation, la valeur retournée est "False". Les fichiers qui suivent celui qui n'a pu être supprimé, ne sont donc pas supprimés.

' Version qui permet le vidage des dossiers temporaires de Windows (vidage de dossiers contenant des fichiers en cours d'utilisation) :

Public Function SupprimeRépertoire(Répertoire As String) As Boolean
    On Error GoTo Erreur
    Dim SousRépertoireOuFichier As String
    Dim Val As String
    Dim MyArray() As String
    Dim I As Long
    Dim J As Long
    SousRépertoireOuFichier = Dir(Répertoire, vbDirectory + vbHidden + vbSystem + vbArchive)
    I = 0
    Do While SousRépertoireOuFichier <> ""
        If SousRépertoireOuFichier <> "." And SousRépertoireOuFichier <> ".." Then
            ' Redimensionne le tableau dynamique tout en conservant les éventuelles valeurs présentes.
            ReDim Preserve MyArray(I + 1)
            If (GetAttr(Répertoire & SousRépertoireOuFichier) And vbDirectory) = vbDirectory Then
                MyArray(I) = Répertoire & SousRépertoireOuFichier & "\"
            Else
                MyArray(I) = Répertoire & SousRépertoireOuFichier
            End If
            I = I + 1
        End If
        SousRépertoireOuFichier = Dir
    Loop
    J = 0
    Do While J < I
        If Right(MyArray(J), 1) = "\" Then
            ' C'est un sous-répertoire. Donc, on effectue un appel récursif.
            SupprimeRépertoire (MyArray(J))
        Else
            ' C'est un fichier.
            ' Resume Next pour passer à l'instruction suivante si la suppression échoue.
            On Error Resume Next
            Val = MyArray(J)
            ' On s'assure que le fichier n'est pas en lecture seule.
            SetAttr Val, vbReadOnly = 0
            ' On supprime le fichier.
            Kill (Val)
            ' On réactive la gestion des erreurs normale.
            On Error GoTo Erreur
        End If
        J = J + 1
    Loop
    If ((Right(Répertoire, 2)) <> ":\") Then
        ' Ce n'est pas la racine du disque, donc on supprime après s'être assuré que le répertoire n'est pas en lecture seule.
        SetAttr Répertoire, vbReadOnly = 0
        RmDir Répertoire
    End If
    SupprimeRépertoire = True
    Exit Function
    
Erreur:
    SupprimeRépertoire = False
End Function

' Remarque : Si cette fonction est utilisée pour vider un répertoire temporaire de Windows, il est fort probable qu'elle retourne False, car elle ne sait évidemment pas supprimer un répertoire contenant des fichiers en cours d'utilisation.
' Elle ne fait que passer ceux qui ne sont pas supprimables. Donc, elle supprimera tout ce qu'il est possible de supprimer.
' Si le dossier temporaire de Windows ne contient aucun fichier en cours d'utilisation, la fonction pourra faire totalement son travail et retournera True.
' N'oubliez pas de recréer le dossier temporaire dans ce cas !
' Sinon, vous risquez d'avoir quelques surprises lors des prochaines installations de logiciels, ...

' Version qui permet, si on le désire, de ne supprimer que les répertoires et les fichiers vides :
  
Public Function SupprimeRépertoire(Répertoire As String, Optional ByVal FichiersVidesSeulement As Boolean = False) As Boolean
    On Error GoTo Erreur
    Dim SousRépertoireOuFichier As String
    Dim Val As String
    Dim MyArray() As String
    Dim I As Long
    Dim J As Long
    SousRépertoireOuFichier = Dir(Répertoire, vbDirectory + vbHidden + vbSystem + vbArchive)
    I = 0
    Do While SousRépertoireOuFichier <> ""
        If SousRépertoireOuFichier <> "." And SousRépertoireOuFichier <> ".." Then
            ' Redimensionne le tableau dynamique tout en conservant les éventuelles valeurs présentes.
            ReDim Preserve MyArray(I + 1)
            If (GetAttr(Répertoire & SousRépertoireOuFichier) And vbDirectory) = vbDirectory Then
                MyArray(I) = Répertoire & SousRépertoireOuFichier & "\"
            Else
                MyArray(I) = Répertoire & SousRépertoireOuFichier
            End If
            I = I + 1
        End If
        SousRépertoireOuFichier = Dir
    Loop
    J = 0
    Do While J < I
        If Right(MyArray(J), 1) = "\" Then
            ' C'est un sous-répertoire. Donc, on effectue un appel récursif.
            SupprimeRépertoire MyArray(J), FichiersVidesSeulement
        Else
            ' C'est un fichier.
            ' Resume Next pour passer à l'instruction suivante si la suppression échoue.
            On Error Resume Next
            Val = MyArray(J)
            
            If (Not FichiersVidesSeulement) Then
                ' On s'assure que le fichier n'est pas en lecture seule.
                SetAttr Val, vbReadOnly = 0
                ' On supprime le fichier.
                Kill (Val)
            Else
                If (FileLen(Val) = 0) Then
                    ' On s'assure que le fichier n'est pas en lecture seule.
                    SetAttr Val, vbReadOnly = 0
                    ' On supprime le fichier.
                    Kill (Val)
                End If
            End If

            ' On réactive la gestion des erreurs normale.
            On Error GoTo Erreur
        End If
        J = J + 1
    Loop
    If ((Right(Répertoire, 2)) <> ":\") Then
        ' Ce n'est pas la racine du disque, donc on supprime après s'être assuré que le répertoire n'est pas en lecture seule.
        SetAttr Répertoire, vbReadOnly = 0
        RmDir Répertoire
    End If
    SupprimeRépertoire = True
    Exit Function
     
Erreur:
    SupprimeRépertoire = False
End Function
  
' Remarque : Toutes les remarques de la deuxième version s'appliquent également à celle-ci. Veuillez les lire aussi...
' Pour ne supprimer que les répertoires et les fichiers vides, effectuez un appel dans le genre de celui qui suit :
' SupprimeRépertoire "X:\MonDossier\", True

Conclusion :


Pas de bugs connus.
Voilà !
Si mon travail vous intéresse, rendez-vous sur mon site Web : http://www.tcedi.com

Bonne programmation !!!

A voir également

Ajouter un commentaire

Commentaires

Signaler
cs_LordBob
Messages postés
2865
Date d'inscription
samedi 2 novembre 2002
Statut
Membre
Dernière intervention
11 mai 2009
 8 -
exactement la source ke je chercher, un grand merci a toi tcedi
Signaler
tcedi
Messages postés
59
Date d'inscription
samedi 27 juillet 2002
Statut
Membre
Dernière intervention
11 septembre 2003
 -
Mais, de rien, LordBob !!! J'espère que cette source te servira bien !
Bonne prog !
Signaler
SupraDolph
Messages postés
196
Date d'inscription
samedi 12 janvier 2002
Statut
Membre
Dernière intervention
1 septembre 2008
 1 -
C pa mal mais, Personellement j'utiliserai plutôt :

Public Function SupprimeRepertoire(Repertoire As String)
If Right(Repertoire, 1) "" Then Repertoire Left(Repertoire, Len(Repertoire) - 1)
Dim fs
Set fs = CreateObject("Scripting.FileSystemObject")
fs.DeleteFile Repertoire & "*.*", True
fs.DeleteFolder Repertoire, False
End Function

Bon Prog
SupraDolph
Signaler
SupraDolph
Messages postés
196
Date d'inscription
samedi 12 janvier 2002
Statut
Membre
Dernière intervention
1 septembre 2008
 1 -
oups sa ne prend pas les backslash

Public Function SupprimeRepertoire(Repertoire As String)
If Right(Repertoire, 1) "BACKSLASH" Then Repertoire Left(Repertoire, Len(Repertoire) - 1)
Dim fs
Set fs = CreateObject("Scripting.FileSystemObject")
fs.DeleteFile Repertoire & "BACKSLASH*.*", True
fs.DeleteFolder Repertoire, False
End Function

Bon Prog
SupraDolph
Signaler
tcedi
Messages postés
59
Date d'inscription
samedi 27 juillet 2002
Statut
Membre
Dernière intervention
11 septembre 2003
 -
C'est vrai qu'il est possible d'utiliser le FSO et que c'est plus simple ! Cependant, si tu utilises le FSO pour supprimer un répertoire avec un bon AntiVirus, ce dernier va te signaler que ton programme exécute peut-être un script malveillant et il va te demander si tu désires l'autoriser à exécuter ce script ou non. Cela prend du temps. Et en général, ça ne plait pas aux utilisateurs finaux d'avoir l'impression de se faire hacker à chaque fois qu'ils utilisent ton programme ! lol !

Merci pour tes commentaires SupraDolph !

Bonne prog !!!
Afficher les 42 commentaires
S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (tcedi)