XL 2010 VBA - Bouton pour supprimer les documents d'un dossier et de ses sous-dossiers

tchi456

XLDnaute Occasionnel
Bonjour,

Je recherche un code VBA pour un bouton qui me permettrait de supprimer tous les documents d'un dossier et de ses sous-dossier (dans l'explorateur de fichiers) en gardant ce dossier et tous les sous-dossiers.

Pouvez-vous m'aider?

Mes meilleures salutations,

Thierry
 
Dernière édition:
Solution
Bonjour @BrunoM45 , @kiki29 , @chti456
@Bruno
la meme en latebinding (pas de ref à activer )
VB:
Sub test()
    RecursifdeltAllfich "C:\Users\patrick\Desktop\Nouveau dossier"
End Sub

Public Sub RecursifdeltAllfich(ByVal oFolder)
    Dim FSO As Object, Sbfolder As Object, Fichier As Object
    Set FSO = CreateObject("scripting.filesystemobject")
    Set oFolder = FSO.GetFolder(oFolder)
    For Each Fichier In oFolder.Files: FSO.DeleteFile (Fichier): Next
    For Each Sbfolder In oFolder.SubFolders: RecursifdeltAllfich (Sbfolder): Next
End Sub

tchi456

XLDnaute Occasionnel
Bonjour kiki29,

Ca me semble intéressant mais comment puis-je adapter ce code pour pouvoir ouvrir un explorateur de fichiers et sélectionner le dossier en question?

VB:
Sub RemoveAllItemsAndFoldersInDeletedItems()
 Dim oDeletedItems As Outlook.Folder
 Dim oFolders As Outlook.Folders
 Dim oItems As Outlook.Items
 Dim i As Long
 'Obtain a reference to deleted items folder
 Set oDeletedItems = Application.Session.GetDefaultFolder(olFolderDeletedItems)
 Set oItems = oDeletedItems.Items
 For i = oItems.Count To 1 Step -1
 oItems.Item(i).Delete
 Next
 Set oFolders = oDeletedItems.Folders
 For i = oFolders.Count To 1 Step -1
 oFolders.Item(i).Delete
 Next
End Sub

Meilleures salutations,

Thierry
 
C

Compte Supprimé 979

Guest
Salut le fil

Ou la, je pense que Kiki29 donne une réponse sans regarder ce qu'elle comporte :rolleyes:

Tchi456 vous parlez de dossier et sous-dossier sur Windows
Le post donné par kiki29, celui de dossier et sous-dossier dans Outlook

Ce qui n'est absolument pas la même chose...
 
C

Compte Supprimé 979

Guest
Re,

Faut dormie Kiki29 🤪 😂

Référence "Microsoft Scipting Runtime" à cocher

Voici le code, mais ATTENTION c'est irréversible (si ligne en commentaire mise en vrai)
VB:
Dim Fso As FileSystemObject, Dossier As Folder, SousDossier As Folder, Fichier As File
 
Public Sub SupFichier(ByVal Dossier As Folder)
  ' Fichiers dans le répertoire ini
  For Each Fichier In Dossier.Files
    ' Si fichier d'un certian type
    If Fichier.Name Like "*.xlsx" Then Debug.Print "Fichier qui sera supprimé : " & Dossier.Path & Fichier.Name
    ' Ligne à enlever en commentaire pour l'exécution
    'If Fichier.Name Like "*.xlsx" Then Kill Dossier.Path & Fichier.Name
  Next
  ' Fichier dans les sous-dossier
  For Each SousDossier In Dossier.SubFolders
    Call SupFichier(SousDossier)
  Next
End Sub

A+
 

patricktoulon

XLDnaute Barbatruc
Bonjour @BrunoM45 , @kiki29 , @chti456
@Bruno
la meme en latebinding (pas de ref à activer )
VB:
Sub test()
    RecursifdeltAllfich "C:\Users\patrick\Desktop\Nouveau dossier"
End Sub

Public Sub RecursifdeltAllfich(ByVal oFolder)
    Dim FSO As Object, Sbfolder As Object, Fichier As Object
    Set FSO = CreateObject("scripting.filesystemobject")
    Set oFolder = FSO.GetFolder(oFolder)
    For Each Fichier In oFolder.Files: FSO.DeleteFile (Fichier): Next
    For Each Sbfolder In oFolder.SubFolders: RecursifdeltAllfich (Sbfolder): Next
End Sub
 

Discussions similaires

Statistiques des forums

Discussions
314 710
Messages
2 112 117
Membres
111 429
dernier inscrit
AFZ