suppression multiple de fichier

Version imprimable

bonjour,
J'aimerais créer un script qui me permettrais de supprimer de mon disque c: tous les dossiers qui sont vide!
pour cela j'avais penser faire quelque chose comme cela :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 Dim stRep 'Nom du répertoire à parcourir Dim oFSO,oFld Set oFSO = CreateObject("Scripting.FileSystemObject") stRep = "C:" If oFSO.FolderExists(stRep) Then Set oFld = oFSO.GetFolder(stRep) MsgBox "Size :" & oFld.Size if oFld.Size < 50 then MsgBox "Name :" & oFld.Name & vbCrlf & _ "Path :" & oFld.Path & vbCrlf & _ "ShortName :" & oFld.ShortName & vbCrlf & _ "ShortPath :" & oFld.ShortPath & vbCrlf & _ "Size :" & oFld.Size & vbCrlf & _ "SubFolders.Count :" & oFld.SubFolders.count end if End If
mais mon soucis c'est que je n'arrive pas à créer une boucle qui parcours l'ensemble du disque.

De plus j'aimerais si possible garder en mémoire le chemin des dossier en question, pour faire une récapitulation à la fin de l'exécution du programme, et demander à l'utilisateur s'il veux les supprimer. (si c'était possible le must serait qu'il puisse choisir quel dossier il veux supprimer dans la liste mais ça c'est vraiment un luxe)

Merci par avance pour votre aide

Une petite procédure récursive inspirée de ton code :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
Dim stRepInital 'Nom du répertoire à parcourir
Dim oFSO,oFld,oSubFloder
Set oFSO = CreateObject("Scripting.FileSystemObject")
stRepInital = "c:\tmp"
 
ParcoursRep stRepInital
Sub ParcoursRep (stRep )
    Wscript.echo "Traite : " & stRep
	If oFSO.FolderExists(stRep) Then
	Set oFld = oFSO.GetFolder(stRep)
	Wscript.Echo "Size :" & oFld.Size
		if oFld.subFolders.count > 0 then 'Teste le nombre de sous-répertoire dans stRep
			Wscript.Echo 	"Name :" & oFld.Path    & "oFld.Count :" & oFld.SubFolders.count
			For each oSubFolder in oFld.subFolders
				ParcoursRep oSubFolder.Path 'appel récursif de la procédure
			Next
		else
			if oFld.Files.count > 0 Then 'Teste le nombre de fichier dans le sous-répertoire
				Wscript.Echo "Non Vide fichiers : " & oFld.Files.count 
			else
				Wscript.Echo 	"===> A detruire ===> " & oFld.Name  & "SubFolders.Count :" & oFld.SubFolders.count
			end if
		end if
	End If
end sub

Voici le code final avec :

une fonction "CreateAfile" qui me permet de créer un fichier récapitulatif des dossiers supprimer
une fonction "DeleteFolder" qui permet de supprimer un dossier
une fonction "WriteText" qui permet d'écrire dans mon fichier texte
une fonction "ParcoursRep" qui est le coeur du programme, la partie récusive

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
Dim stRepInital, suppr 'Nom du répertoire à parcourir
Dim oFSO, oFld, oSubFloder
dim message, RecupFile
Set oFSO = CreateObject("Scripting.FileSystemObject")
stRepInital = "D:\Mes Documents\"
RecupFile = "D:\RecapSupprDossierVide_" & Day(Now) & Month(Now) & Year(Now) & ".txt"
 
CreateAfile(RecupFile)
 
ParcoursRep stRepInital
Sub ParcoursRep (stRep )
    If oFSO.FolderExists(stRep) Then
	Set oFld = oFSO.GetFolder(stRep)
		if oFld.subFolders.count > 0 then 'Teste le nombre de sous-répertoire dans stRep
			For each oSubFolder in oFld.subFolders
				ParcoursRep oSubFolder.Path 'appel récursif de la procédure
			Next
		else
			if oFld.Files.count = 0 Then 'Teste le nombre de fichier dans le sous-répertoire
				message = "Voulez vous supprimer ce dossier? : " & vbCr & oFld.Path
				if MsgBox (message , vbYesNo) = vbYes then
					WriteText RecupFile, oFld.Path
					DeleteFolder(oFld.Path)
				end if
			end if
		end if
	End If
end sub
 
function DeleteFolder(FolderToDelete)
	Dim oFSO
	Set oFSO = CreateObject("Scripting.FileSystemObject")
	oFSO.DeleteFolder FolderToDelete,True  ' Le paramétre "Force" à true permet d'effacer les fichiers en lectures seules.
end function
 
Function CreateAfile(resumeFile)
   Dim fso, MyFile 'fso pour File System Object
   Set fso = CreateObject("Scripting.FileSystemObject")
   Set MyFile = fso.CreateTextFile(resumeFile, True)
End Function
 
Function WriteText(MyFile,myText)
   Const ForReading = 1, ForWriting = 2, ForAppending = 8
   Const TristateUseDefault = -2, TristateTrue = -1, TristateFalse = 0
   Dim fso, f, ts
   Set fso = CreateObject("Scripting.FileSystemObject")
   Set f = fso.GetFile(MyFile)
   Set ts = f.OpenAsTextStream(ForAppending, TristateUseDefault)
   ts.WriteLine myText
   ts.Close
End Function

Merci bcp pour votre aide.

11/08/2009, 11h27
_xme_

C'est joli comme fonction :)

Pense au tag résolu ;)