Enfin la suppression d'une arborescence sans api ni filesystemobject !

Contenu du snippet

Suppression d'un répertoire SANS API et SANS l'utilisation de FSO. Utilisation récursise d'une fonction utilisant l'instruction DIR. Même les fichiers / répertoires ayant les attributs systèmes / cachés / ReadOnly seront supprimés ! Donc, si vous le fait à la racine d'un disque, VOUS SUPPRIMEREZ TOUT LE CONTENU DE VOTRE DISQUE !

Source / Exemple :


Private Sub DelDir(ByVal PStrPath As String, Optional ByVal PBolDelSubDir As Boolean = True)
Const MODULE = "DelDir"
Dim LStrNomFic As String

    On Error GoTo TrtErrDelDir
    
    If Right$(PStrPath, 1) = "\" Then PStrPath = Left$(PStrPath, Len(PStrPath) - 1)
    
    ' Parcours récursif des sous-répertoires.

    If PBolDelSubDir Then
        Do
            LStrNomFic = Dir(PStrPath & "\*.*", vbDirectory)
            While LStrNomFic = "." Or LStrNomFic = ".." Or (GetAttr(PStrPath & "\" & LStrNomFic) And vbDirectory) <> vbDirectory
                LStrNomFic = Dir
            Wend
            
            If LStrNomFic <> "" And (GetAttr(PStrPath & "\" & LStrNomFic) And vbDirectory) = vbDirectory Then
                Call DelDir(PStrPath & "\" & LStrNomFic)
            End If
        Loop Until LStrNomFic = ""
    End If
    
    ' Suppression des fichiers se trouvant dans le répertoire en cours.

    LStrNomFic = Dir(PStrPath & "\*.*", vbNormal + vbReadOnly + vbHidden + vbSystem + vbArchive)
    While LStrNomFic <> ""
        SetAttr PStrPath & "\" & LStrNomFic, vbNormal
        DoEvents
        
        Kill PStrPath & "\" & LStrNomFic
        DoEvents
        
        LStrNomFic = Dir
    Wend
    
    If Len(PStrPath) > 3 Then
        SetAttr PStrPath, vbNormal
        DoEvents
        
        RmDir PStrPath
    End If
    
ExitDelDir:
    
    DoEvents
    
    Exit Sub
    
TrtErrDelDir:
    
    MsgBox "MODULE : " & MODULE & vbCrLf _
        & "PARAM. :" & vbCrLf _
        & "  Path   = " & PStrPath & vbCrLf _
        & "  SubDir = " & PBolDelSubDir & vbCrLf _
        & "ERREUR : " & Err.Number & vbCrLf _
        & Err.Description, vbCritical, App.EXEName
    
    Resume ExitDelDir

End Sub

Conclusion :


Appel du SUB :
DelDir("C:\Windows\Temp", True) -> Suppression du répertoire Temp et de ses sous-répertoires. A la fin de cette opération le répertoire C:\Windows\Temp n'existera plus !
DelDir("C:\Windows\Temp", False) -> Suppression UNIQUEMENT DES FICHIERS se trouvant dans le répertoire Temp (pas de parcours dans les sous-répertoires).

A voir également

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.