Effacement de dossiers et fichiers

Bonjour,

je suis novice en vbscript et j'ai très peu de temps pour améliorer mon script.

Mon besoin: Avoir un script qui efface tous les fichiers qui sont plus vieux que 15 jours et effacer leur dossier si ces derniers sont vides. Il y a une condition à respecter, certains dossiers ne doivent pas être supprimés. (Ceux de la racine).

Les dossiers à ne pas supprimés:
Achat
Vente
R&D

Mon problème:
Avec mon script, les fichiers s'effacent et les dossiers vide également sauf si ces dossiers se trouvent dans un répertoire à ne pas supprimer.

Mon script actuel:

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
on error resume next
 
'Déclaration de variables
Dim folder
dim Subfolder
dim path
Dim FSO
Dim B
 
'Création de l'objet
Set FSO = CreateObject("Scripting.FileSystemObject")
 
'Chemin du Temp
path = "\\chczabf0001\Data\Commun\Temp\Achats"
 
'Appel de la fonction recurcive avec comme argument le chemin du repertoire racine
recurcive path
 
'Fonction récurcive pour traiter tout l'arboresence des dossiers
function recurcive(chemin) 
	set folder = FSO.GetFolder (chemin) 'Utilisation du FSO pour prendre le dossier racine
	set Subfolder = folder.SubFolders 'Définition de la varibale pour les S/dossiers
	for each A in Subfolder 'pour chaque dossier dans le sous dossier racine
		Set fic = A.Files 'definition de la variables toucher les fichier des dossier
		fichier fic 'appel de la fontion fichier
		recurcive A 're-appel de la fonction recurcive pour traiter les S/dossiers
	next
end function
 
function fichier(fic) 'fonction qui traite les fichiers dans les dossiers A
	For Each objFile in fic 'pour chaque fichier dans dossiers de fichier
		Set f = fso.GetFile(objfile) 'utilisation du FSO pour prendre le fichier
		If DateDiff("D", objfile.DateLastModified, now) > 15 Then 'si la derniére modification du fichier est plus ancienne que X jours
			'msgbox objfile & " a suprimer" 'alors effacer le fichier avec option de forcer pour les fichier en lecture seule FSO.DeleteFile f, force = yes
			FSO.DeleteFile f
		'end if 'fin du SI
		next
	end function 'fin de la fonction
 
Set fic = folder.Files
fichier fic
 
set folder = FSO.GetFolder (path)'utilisation du FSO pour prendre le dossier
	For Each B in folder.subfolders 'pour chaque dossier dans le dossier racine
		If B.size = 0 Then 'si la taille du dossier est egal a 0 (donc vide)
		'msgbox B & B.size 'effacer le dossier
		FSO.DeleteFolder B, force = yes
		End If 'fin du SI
	Next

2ème requête:
Est-il possible de supprimer un dossier qui ne se trouve pas à la racine mais qui porte le même nom qu'un dossier que l'on ne veut pas supprimer?

:D:D Merci de votre aide :ccool:

Salut

:koi:

Citation:

Envoyé par 2ème requête:

Est-il possible de supprimer un dossier qui ne se trouve pas à la racine mais qui porte le même nom qu'un dossier que l'on ne veut pas supprimer?

:calim2:

Bon a force de chercher, j'ai trouvé toutes mes solutions.

Code:

1
2
3
4
5
6
7
8
9
10
11
'Efface les sous-dossiers si ils sont vide
For each subfold in FSO.GetFolder(path).SubFolders 'Pour chaque sous-dossiers dans le path
	subpath = "C:\vbscript\temp\" & subfold.Name 'On définit une nouvelle variable avec le nom des sous-dossiers au 1er niveau
	set folder = FSO.GetFolder (subpath)'utilisation du FSO pour prendre le dossier
	For Each B in folder.subfolders 'pour chaque dossier dans le sous-dossier racine
		If B.size = 0 Then 'si la taille du dossier est egal a 0 (donc vide)
		'msgbox B & B.size 'effacer le dossier
		FSO.DeleteFolder B, force = yes
		End If 'fin du SI
	Next 
Next

Cette partie de commande permet de lister dans un dossier, les sous-dossier du 1er niveau. Par la suite, cela va effacer tous les dossiers vide dans ces sous-dossier du 1er niveau.

Bonne journàe