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

[tchi456]

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

 

[kiki29]

Salut, voir ici et adapter à ton contexte.

 

[tchi456]

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?

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

 

[Compte Supprimé 979]

Salut le fil

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

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...

 

[kiki29]

Salut, la fatigue ..., enfin bref voir sur JBoisgontier

 

[Compte Supprimé 979]

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)

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]

Bonjour @BrunoM45 , @kiki29 , @chti456
@Bruno
la meme en latebinding (pas de ref à activer )

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]

Bonjour à tous,

Merci beaucoup pour vos propositions. Patrick votre code me convient tout à fait.

Bon début de semaine à tous et merci pour votre aide.