XL 2010 Bouton - Supprimer photos JPG dans un dossier et ses sous-dossiers

Titi456

XLDnaute Junior
Bonjour,

Je recherche un code VBA à mettre sur un bouton pour pouvoir supprimer toutes les photos (fichiers .jpg uniquement) qui se trouvent dans un dossier et ses sous-dossiers.

Exemple: si je clique sur le bouton, un explorateur de fichier apparait et je peux sélectionner un dossier pour lequel j'aimerais supprimer toutes les photos JPG se trouvant dans ce dossier et ses sous-dossiers.

Pouvez-vous m'aider?

Mes meilleures salutations,

Thierry
 
Solution
Pour répondre précisément à la demande :
VB:
Option Explicit
Option Compare Text
Dim Fso As Object
Sub Test()
    Delfile "jpg"
End Sub
Sub Delfile(Optional Ext = "jpg")
    With Application.FileDialog(msoFileDialogFolderPicker)
        .AllowMultiSelect = False
        If .Show Then
            Set Fso = CreateObject("Scripting.FileSystemObject")
                KillJpg .SelectedItems(1), Ext
            Set Fso = Nothing
        End If
    End With
End Sub
Sub KillJpg(Folder, Ext)
Dim File, Sf
    Debug.Print Folder
    With Fso.getfolder(Folder)
        For Each File In .Files
            If Fso.GetExtensionName(File) = Ext Then
                Debug.Print vbTab, File.Name
                File.Delete
            End If
        Next...

halecs93

XLDnaute Impliqué
Un début de piste

Sub EffacerFichiersJPG()
Dim cheminDossier As String
Dim nomFichier As String

cheminDossier = "chemin_du_dossier_a_nettoyer/" 'Modifier le chemin du dossier selon vos besoins
nomFichier = Dir(cheminDossier & "*.jpg")

Do While nomFichier <> ""
Kill cheminDossier & nomFichier
nomFichier = Dir()
Loop

MsgBox "Tous les fichiers JPG ont été supprimés du dossier."
End Sub


Attention, ça efface sans possibilité de retour en arrière
 

Titi456

XLDnaute Junior
Bonjour halecs93,

Merci beaucoup pour votre proposition qui me semble correct mais ça ne fonctionne malheureusement pas chez moi.

Au départ je pensais que c'était à cause de l'extension des fichiers qui n'était pas affichée mais apparemment c'est le code lui-même qui ne fonctionne pas.

Mes meilleures salutations,

Thierry
 

Pièces jointes

  • Test.xlsm
    17.6 KB · Affichages: 2
Dernière édition:

fanch55

XLDnaute Barbatruc
Bonjour, vous avez oublié de finir le cheminDossier par "\"
VB:
Option Explicit

Sub EffacerTypeDeFichier()
Dim cheminDossier As String
Dim nomFichier As String

cheminDossier = "C:\Users\tni\Desktop\Nouveau dossier\" 'Modifier le chemin du dossier
nomFichier = Dir(cheminDossier & "*.jpg")

Do While nomFichier <> ""
    Kill cheminDossier & nomFichier
    nomFichier = Dir()
Loop

MsgBox "Tous les fichiers jpg ont été supprimés du dossier."
End Sub
 

patricktoulon

XLDnaute Barbatruc
re
perso avec dir je le fait mais c'est plus simple avec FSO
avec fso tu peux killer le fichier pendant la boucle for each file in .....
tandis qu'avec dir si tu supprime un fichier le dir n'est plus valide
il faut alors remplir une variable tableau avec les chemins de fichiers et les supprimer dans une seconde boucle

il y en a à foison des exemples ici ;)
 

patricktoulon

XLDnaute Barbatruc
remarque tu peux tres bien faire si il y a seulement 2 etage dans l'arborecence un
VB:
x= dir(chemin maitre,vbdirectory)
do while  x<>""
if getattr(chemin &"\"& x) and vbdirectory=vbdirectory  then
on error resume next
kill(chemin &"\"& x"\*.jpg"
err.clear
loop
on error goto 0

le on error c'est pour éviter de devoir fair un test dir fichier qui n'est pas possible puisque que dir n'est pas récursif et entrerais en conflit avec le dir vbdirectory

si l'arborescence est plus complexe alors il faudra stocker comme je le disais dans un array les noms (complets) dans une fonction récursive avec dir vbdirectory je dis bien fonction récursive et non un dir recursif

;)
 

fanch55

XLDnaute Barbatruc
Pour répondre précisément à la demande :
VB:
Option Explicit
Option Compare Text
Dim Fso As Object
Sub Test()
    Delfile "jpg"
End Sub
Sub Delfile(Optional Ext = "jpg")
    With Application.FileDialog(msoFileDialogFolderPicker)
        .AllowMultiSelect = False
        If .Show Then
            Set Fso = CreateObject("Scripting.FileSystemObject")
                KillJpg .SelectedItems(1), Ext
            Set Fso = Nothing
        End If
    End With
End Sub
Sub KillJpg(Folder, Ext)
Dim File, Sf
    Debug.Print Folder
    With Fso.getfolder(Folder)
        For Each File In .Files
            If Fso.GetExtensionName(File) = Ext Then
                Debug.Print vbTab, File.Name
                File.Delete
            End If
        Next
        For Each Sf In .SubFolders
            KillJpg Sf, Ext
        Next
    End With
End Sub
 

Titi456

XLDnaute Junior
Pour répondre précisément à la demande :
VB:
Option Explicit
Option Compare Text
Dim Fso As Object
Sub Test()
    Delfile "jpg"
End Sub
Sub Delfile(Optional Ext = "jpg")
    With Application.FileDialog(msoFileDialogFolderPicker)
        .AllowMultiSelect = False
        If .Show Then
            Set Fso = CreateObject("Scripting.FileSystemObject")
                KillJpg .SelectedItems(1), Ext
            Set Fso = Nothing
        End If
    End With
End Sub
Sub KillJpg(Folder, Ext)
Dim File, Sf
    Debug.Print Folder
    With Fso.getfolder(Folder)
        For Each File In .Files
            If Fso.GetExtensionName(File) = Ext Then
                Debug.Print vbTab, File.Name
                File.Delete
            End If
        Next
        For Each Sf In .SubFolders
            KillJpg Sf, Ext
        Next
    End With
End Sub
Bonjour Fanch55,

Mais c'est exactement le code qu'il me fallait. Je peux pas dire mieux. Vous êtes doué!

Merci beaucoup pour votre aide et bon début de semaine à vous tous !
 

Discussions similaires

Statistiques des forums

Discussions
313 197
Messages
2 096 109
Membres
106 500
dernier inscrit
mmontagu