Discussion :

[ludojojo]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[SfJ5Rpw8]

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[ludojojo]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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.

[_xme_]

C'est joli comme fonction

Pense au tag résolu