Vider un répertoire, ses sous-répertoires et les fichiers contenus dedans avec api!

Commenter

Contenu du snippet

Cette source permet de supprimer les fichiers et répertoires avec les apis. On peut ainsi vérifier qu'il n'y a pas eu d'erreurs. En plus il vaut mieux utiliser les apis que filesystemobject (détecté par certaine antivirus). J'attend vos commentaires sur la qualité du code et j'espère que vous trouverez des améliorations :).

Source / Exemple : 


Public Function DelDir(sPath As String, Optional SubDirectory As Boolean = False) As Long
On Error Resume Next

    Dim FileArray As WIN32_FIND_DATA
    Dim hFindFile As Long
    Dim sFileOrDir As String
    Dim sDirectory As String
    Dim isDir As Long
    Dim nSubDir As Long
    Dim SubDir() As String
    Dim sRet As Long

    If SubDirectory = False Then DelDir = 1

    hFindFile = FindFirstFile(sPath & "*.*", FileArray)
    If hFindFile <> INVALID_HANDLE_VALUE Then
        Do
            sFileOrDir = Left$(FileArray.cFileName, InStr(FileArray.cFileName, vbNullChar) - 1)
            DoEvents
            
            If Left$(sFileOrDir, 1) <> "." Then
                isDir = (FileArray.dwFileAttributes And &H10)
                
                If isDir = False Then
                    SetAttr sPath & "\" & sFileOrDir, vbNormal
                    DoEvents
                    sRet = DeleteFile(sPath & "\" & sFileOrDir)
                    If sRet = 0 Then DelDir = 0
                Else
                    nSubDir = nSubDir + 1
                    ReDim Preserve SubDir(1 To nSubDir)
                    
                    sDirectory = sPath & "\" & Mid$(FileArray.cFileName, 1, InStr(1, FileArray.cFileName, vbNullChar) - 1) & "\"
                    SubDir(nSubDir) = sDirectory
                    DelDir = DelDir(sDirectory, True)
                End If
            End If

        Loop Until FindNextFile(hFindFile, FileArray) = 0
        
        If nSubDir <> 0 Then
            For i = 1 To nSubDir
                SetAttr SubDir(i), vbNormal
                DoEvents
                RmDir SubDir(i)
                If Err.Number <> 0 Then DelDir = 0
            Next i
        End If
        
        FindClose hFindFile
        Erase SubDir
        
        If SubDirectory = False Then
            SetAttr sPath, vbNormal
            DoEvents

            RmDir sPath
            If Err.Number <> 0 Then DelDir = 0
        End If
    End If
End Function

A voir également

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 (BozzoDodo)