'==================================================================================
'
'   Dans environnement VBA
'   Outils | Références COCHER Microsoft Scripting Runtime
 
'==================================================================================
 
Option Explicit
Const Dossier As String = "C:\Transfert\Essais\"
 
Sub Tst()
Dim DossierOk As String
    DossierOk = Dossier
    If Right(DossierOk, 1) <> "\" Then DossierOk = DossierOk & "\"
     
    EffacerTout DossierOk, True
    'EffacerSeulement DossierOk, True, "xls"
End Sub
 
Private Sub EffacerTout(ByVal Dossier As String, ByVal InclureSousDossiers As Boolean)
Dim FSO As Scripting.FileSystemObject
Dim DossierSource As Scripting.Folder, SousDossier As Scripting.Folder
Dim Fichier As Scripting.File
 
    Set FSO = New Scripting.FileSystemObject
    Set DossierSource = FSO.GetFolder(Dossier)
     
    For Each Fichier In DossierSource.Files
        Fichier.Delete
    Next Fichier
     
    If InclureSousDossiers Then
        For Each SousDossier In DossierSource.SubFolders
            EffacerTout SousDossier.Path, True
            If SousDossier.Files.Count = 0 Then SousDossier.Delete
        Next SousDossier
    End If
     
    Set Fichier = Nothing
    Set DossierSource = Nothing
    Set FSO = Nothing
End Sub
 
Private Sub EffacerSeulement(ByVal Dossier As String, ByVal InclureSousDossiers As Boolean, ByVal Extension As String)
Dim FSO As Scripting.FileSystemObject
Dim DossierSource As Scripting.Folder, SousDossier As Scripting.Folder
Dim Fichier As Scripting.File
 
    Set FSO = New Scripting.FileSystemObject
    Set DossierSource = FSO.GetFolder(Dossier)
     
    For Each Fichier In DossierSource.Files
        If UCase(FSO.GetExtensionName(Fichier)) = UCase(Extension) Then
            Fichier.Delete
        End If
    Next Fichier
     
    If InclureSousDossiers Then
        For Each SousDossier In DossierSource.SubFolders
            EffacerSeulement SousDossier.Path, True, Extension
            If SousDossier.Files.Count = 0 Then SousDossier.Delete
        Next SousDossier
    End If
     
    Set Fichier = Nothing
    Set DossierSource = Nothing
    Set FSO = Nothing
End Sub