Suppression de fichiers : prise en compte des sous répertoires(vbs)

Version imprimable

Bonjour je suis admin réseau, je voudrais améliorer mon script de suppression de fichier .bak.

Ayant fait un peu le tour des forums j'ai réussi à récupérer un script me permettant de supprimer tous les fichiers vieux de 31 jours avec l'extension .bak. J'ai remarqué que le script ne prenait pas en compte les sous dossiers.

La aussi il existe des scripts pour parcourir les sous dossiers mais mes connaissances vb ne me permettent pas de l'adapter a mon script. Pourriez vous me donner un coup de main s'il vous plait?

Mon script:

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
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
 Public function DeleteOlderFiles (ByVal FoldersToProcess, ByVal MaxDayAge, ByVal Extension)
 
    Dim FolderArray
    Dim FolderPath
    Dim objFSO
    Dim ObjFolder
    Dim ObjFile
    Dim FileAge
    Dim ErrorNumber
 
    If DebugMode = 1 Then
    Wscript.echo "DeleteOlderFiles() function"
    End If
 
    Set objFSO = CreateObject("Scripting.FileSystemObject")
 
    FolderArray = Split(FoldersToProcess, ";")
    For Each FolderPath In FolderArray
    If objFSO.FolderExists(FolderPath) Then
    If DebugMode = 1 Then
    Wscript.echo "Process " & FolderPath & " folder"
    End If
 
    Set ObjFolder = objFSO.GetFolder(FolderPath)
    For Each ObjFile In ObjFolder.Files
    'Wscript.echo "File " & ObjFile.Name
    If ExtensionFichier(ObjFile.Name) = Extension Then
    FileAge = DateDiff("d", ObjFile.DateCreated, Now())
    If DebugMode = 1 Then
    Wscript.echo "File " & ObjFile.Name & " have " & FileAge & " day(s)"
    End If
 
    If FileAge > MaxDayAge Then
    If DebugMode = 1 Then
    Wscript.echo "Deleting " & ObjFile.Name
    End If
 
    Err.Clear
    On Error Resume Next
    Call objFSO.DeleteFile(objFile.Path)
    ErrorNumber = Err.Number
    On Error goto 0
    Select Case NumeroErreur
    Case 0
    If DebugMode = 1 Then
    Wscript.echo "Done"
    End If
    Case Else
    Wscript.echo "Error for deleting file : " & Err.Description
    End Select
 
    End If
    End If 'If ExtensionFichier(ObjFile.Name) = "bak" Then
    Next
 
    Set ObjFolder = Nothing
    Else
    Wscript.echo "Folder " & FolderPath & " dont exist"
    End If
    Next
 
    Set objFSO = Nothing
 
    End Function
 
    Public Function ExtensionFichier(ByVal CheminFichier)
 
    'Retourne l'extension du fichier
    Dim Position
    ExtensionFichier = ""
 
    Position = InStrRev(CheminFichier,".")
 
    If (Position > 0) And (Position < Len(CheminFichier)) Then
    ExtensionFichier = Mid(CheminFichier,Position+1)
    ExtensionFichier = Lcase(ExtensionFichier)
    End If
 
    End Function
 
    Call DeleteOlderFiles("D:\",31,"bak")

Merci d'avance

Bonjour,

Pour ton besoin, il suffirait de rendre la fonction récursive, en l'appelant à nouveau pour chaque sous répertoire trouvé.
Comme cela par exemple :

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
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
 Public function DeleteOlderFiles (ByVal FoldersToProcess, ByVal MaxDayAge, ByVal Extension)
 
    Dim FolderArray
    Dim FolderPath
    Dim objFSO
    Dim ObjFolder
    Dim objSubFolder
    Dim ObjFile
    Dim FileAge
    Dim ErrorNumber
 
    If DebugMode = 1 Then
    Wscript.echo "DeleteOlderFiles() function"
    End If
 
    Set objFSO = CreateObject("Scripting.FileSystemObject")
 
    FolderArray = Split(FoldersToProcess, ";")
    For Each FolderPath In FolderArray
    If objFSO.FolderExists(FolderPath) Then
    If DebugMode = 1 Then
    Wscript.echo "Process " & FolderPath & " folder"
    End If
 
    Set ObjFolder = objFSO.GetFolder(FolderPath)
    For Each ObjFile In ObjFolder.Files
    'Wscript.echo "File " & ObjFile.Name
    If ExtensionFichier(ObjFile.Name) = Extension Then
    FileAge = DateDiff("d", ObjFile.DateCreated, Now())
    If DebugMode = 1 Then
    Wscript.echo "File " & ObjFile.Name & " have " & FileAge & " day(s)"
    End If
 
    If FileAge > MaxDayAge Then
    If DebugMode = 1 Then
    Wscript.echo "Deleting " & ObjFile.Name
    End If
 
    Err.Clear
    On Error Resume Next
    Call objFSO.DeleteFile(objFile.Path)
    ErrorNumber = Err.Number
    On Error goto 0
    Select Case NumeroErreur
    Case 0
    If DebugMode = 1 Then
    Wscript.echo "Done"
    End If
    Case Else
    Wscript.echo "Error for deleting file : " & Err.Description
    End Select
 
    End If
    End If 'If ExtensionFichier(ObjFile.Name) = "bak" Then
    Next
 
    For Each objSubFolder In ObjFolder.SubFolders
        DeleteOlderFiles(objSubFolder.Path,MaxDayAge,Extension)
    Next
 
    Set ObjFolder = Nothing
    Else
    Wscript.echo "Folder " & FolderPath & " dont exist"
    End If
    Next
 
    Set objFSO = Nothing
 
    End Function
 
    Public Function ExtensionFichier(ByVal CheminFichier)
 
    'Retourne l'extension du fichier
    Dim Position
    ExtensionFichier = ""
 
    Position = InStrRev(CheminFichier,".")
 
    If (Position > 0) And (Position < Len(CheminFichier)) Then
    ExtensionFichier = Mid(CheminFichier,Position+1)
    ExtensionFichier = Lcase(ExtensionFichier)
    End If
 
    End Function
 
    Call DeleteOlderFiles("D:\",31,"bak")

Par contre, si je peux me permettre quelques remarques sur ce code :
- L'indentation n'est pas bonne; cela rend le code très difficile à lire, et peut induire en erreur
- Ta fonction DeleteOlderFiles ne retourne rien. Elle pourrait être donc transformée en procédure (Sub)

Bonne continuation.

09/10/2012, 08h43
maskk

Merci beaucoup Pitchalov,
Je vais tester tout ca , et indenter comme il faut !
Mes connaissances sont encore très très mince niveau développement pardonne moi ^^

J'ai donc refais mon 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
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
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
 
Public function DeleteOlderFiles (ByVal FoldersToProcess, ByVal MaxDayAge, ByVal Extension)
 
	Dim FolderArray
	Dim FolderPath
	Dim objFSO
	Dim ObjFolder
	Dim objSubFolder
	Dim ObjFile
	Dim FileAge
	Dim ErrorNumber
 
		If DebugMode = 1 Then
			Wscript.echo "DeleteOlderFiles() function"
		End If
 
	Set objFSO = CreateObject("Scripting.FileSystemObject")
 
	FolderArray = Split(FoldersToProcess, ";")
	For Each FolderPath In FolderArray
		If objFSO.FolderExists(FolderPath) Then
			If DebugMode = 1 Then
				Wscript.echo "Process " & FolderPath & " folder"
			End If
			Set ObjFolder = objFSO.GetFolder(FolderPath)
			For Each ObjFile In ObjFolder.Files
			'Wscript.echo "File " & ObjFile.Name
			If ExtensionFichier(ObjFile.Name) = Extension Then
				FileAge = DateDiff("d", ObjFile.DateCreated, Now())
				If DebugMode = 1 Then
					Wscript.echo "File " & ObjFile.Name & " have " & FileAge & " day(s)"
				End If
 
				If FileAge > MaxDayAge Then
					If DebugMode = 1 Then
						Wscript.echo "Deleting " & ObjFile.Name
					End If
					Err.Clear
					On Error Resume Next
					Call objFSO.DeleteFile(objFile.Path)
					ErrorNumber = Err.Number
					On Error goto 0
					Select Case NumeroErreur
					Case 0
					If DebugMode = 1 Then
						Wscript.echo "Done"
					End If
					Case Else
					Wscript.echo "Error for deleting file : " & Err.Description
					End Select
 
				End If
			End If 'If ExtensionFichier(ObjFile.Name) = "bak" Then
		Next
		For Each objSubFolder In ObjFolder.SubFolders
			DeleteOlderFiles(objSubFolder.Path,MaxDayAge,Extension)
		Next
		Set ObjFolder = Nothing
		Else
			Wscript.echo "Folder " & FolderPath & " dont exist"
		End If
	Next
 
	Set objFSO = Nothing
End Function
 
Public Function ExtensionFichier(ByVal CheminFichier)
 
'Retourne l'extension du fichier
Dim Position
ExtensionFichier = ""
 
Position = InStrRev(CheminFichier,".")
 
	If (Position > 0) And (Position < Len(CheminFichier)) Then
		ExtensionFichier = Mid(CheminFichier,Position+1)
		ExtensionFichier = Lcase(ExtensionFichier)
	End If
 
End Function
 
Call DeleteOlderFiles("D:\",31,"bak")

En revanche j'ai une erreur ligne 55 la fonction sub n'admet pas de parentheses

Bonjour,

Effectivement, l'appel d'une procédure (Sub) en vbscript se fait sans parenthèses, contrairement à l'appel d'une fonction (Function).
A la ligne 55, c'est effectivement une fonction qui est appelée, mais sans récupérer la valeur de retour (qui est vide d'ailleurs) ni utiliser Call, et donc l'interpréteur le voit comme un appel de procédure.

Ces quelques petites modifications devraient faire fonctionner 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
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
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
Sub DeleteOlderFiles (FoldersToProcess, MaxDayAge, Extension)
 
	Dim FolderArray
	Dim FolderPath
	Dim objFSO
	Dim ObjFolder
	Dim objSubFolder
	Dim ObjFile
	Dim FileAge
	Dim ErrorNumber
 
	If DebugMode = 1 Then
		Wscript.echo "DeleteOlderFiles() function"
	End If
 
	Set objFSO = CreateObject("Scripting.FileSystemObject")
 
	FolderArray = Split(FoldersToProcess, ";")
	For Each FolderPath In FolderArray
		If objFSO.FolderExists(FolderPath) Then
			If DebugMode = 1 Then
				Wscript.echo "Process " & FolderPath & " folder"
			End If
			Set ObjFolder = objFSO.GetFolder(FolderPath)
			For Each ObjFile In ObjFolder.Files
			'Wscript.echo "File " & ObjFile.Name
			If ExtensionFichier(ObjFile.Name) = Extension Then
				FileAge = DateDiff("d", ObjFile.DateCreated, Now())
				If DebugMode = 1 Then
					Wscript.echo "File " & ObjFile.Name & " have " & FileAge & " day(s)"
				End If
 
				If FileAge > MaxDayAge Then
					If DebugMode = 1 Then
						Wscript.echo "Deleting " & ObjFile.Name
					End If
					Err.Clear
					On Error Resume Next
					Call objFSO.DeleteFile(objFile.Path)
					ErrorNumber = Err.Number
					On Error goto 0
					Select Case NumeroErreur
					Case 0
					If DebugMode = 1 Then
						Wscript.echo "Done"
					End If
					Case Else
					Wscript.echo "Error for deleting file : " & Err.Description
					End Select
 
				End If
			End If 'If ExtensionFichier(ObjFile.Name) = "bak" Then
		Next
		For Each objSubFolder In ObjFolder.SubFolders
			DeleteOlderFiles(objSubFolder.Path,MaxDayAge,Extension)
		Next
		Set ObjFolder = Nothing
		Else
			Wscript.echo "Folder " & FolderPath & " dont exist"
		End If
	Next
 
	Set objFSO = Nothing
End Sub
 
Function ExtensionFichier(CheminFichier)
 'Retourne l'extension du fichier
	Dim Position
	ExtensionFichier = ""
 
	Position = InStrRev(CheminFichier,".")
 
	If (Position > 0) And (Position < Len(CheminFichier)) Then
		ExtensionFichier = Mid(CheminFichier,Position+1)
		ExtensionFichier = Lcase(ExtensionFichier)
	End If
 
End Function
 
DeleteOlderFiles "D:\",31,"bak"

Bonne continuation

09/10/2012, 12h03
maskk

Désolé Pitchalov, ca me retourne encore la même erreur et toujours sur le passage :
DeleteOlderFiles(objSubFolder.Path,MaxDayAge,Extension)
09/10/2012, 12h21
ProgElecT

Salut
Si tu enlevés les parenthèses ligne 55 ? DeleteOlderFiles objSubFolder.Path,MaxDayAge,Extension
09/10/2012, 12h26
maskk

Bonjour Francis,
Apres l'explication de manu c'est ce que j'ai essayé, du coup il ne me remonte plus d'erreur , en revanche aucun fichier ne se supprime :(
09/10/2012, 12h37
ProgElecT

Rentres tu dans la condition If FileAge > MaxDayAge Then un MsgBox de Filage et MaxDayAge juste avant cette ligne pourrait éventuellement faire avancer les choses.
09/10/2012, 12h57
maskk

Citation:

Envoyé par ProgElecT

Rentres tu dans la condition If FileAge > MaxDayAge Then un MsgBox de Filage et

Alors je viens de le faire ca ne me retourne rien .

(MsgBox FileAge & MaxDayAge apres le "then")

Comme je débute je suis pas sur de mes tests mais en mettant fileage et maxdayage avant la condition j'ai plusieur fois le mgsbox:
pour fileage : 0 et maxdayage 31
09/10/2012, 13h05
maskk

Ok j'ai compris,
la manip était bonne mais ayant copié mes fichiers en local pour le test le FileAge est retombé à 0 j'imagine ce qui est plutot logique du coup .

Le script marche impeccablement, je vous remercies beaucoup de votre aide sans vous j'étais bien coincé merci encore !
09/10/2012, 13h09
ProgElecT

pitchalov est quelqu'un de compétant, il eu été étonnant que le code pose problème ;)
Bonne continuation.