Suppression de certains fichiers dans un répertoire particulier et récursivement dans ses sous-répertoires, créés/modifiés/a

Soyez le premier à donner votre avis sur cette source.

Vue 9 093 fois - Téléchargée 337 fois

Description

Ce programme a été développé en vbscript, les 4 paramètres à entrer sont
- le répertoire, dans lequel les fichiers sont a supprimer
- l'extension du programme comme par exemple *.doc
- et les deux dates entre lesquels le fichier a du être créé/modifié/accédé pour être effacé (les lignes 82 et 134 doivent être modifiées en fonction du type de date à filtrer)

ce code est une évolution de celui déposé par koshka
http://www.vbfrance.com/codes/SUPPRESSION-CERTAINS-FICHIERS-DANS-REPERTOIRE-PARTICULIER-CREES-CERTAINE_26866.aspx

Source / Exemple :


Dim args, fso
Dim dest
Dim ext
Dim mess

Set fso   = WScript.CreateObject("Scripting.FileSystemObject")
Set args  = Wscript.Arguments

If args.count<>4 and args.count<>3 Then
	mess= "Parameters problem" &VBCRLF
	syntaxe mess
End if	
	'data processing
dest=args(0)
If right(dest,1)="\" Then dest=left(dest,len(dest)-1)
dest=dest & "\"
If fso.FolderExists(dest)=false Then
	mess ="The folder doesn't exist" &VBCRLF
	syntaxe mess
end if

datefrom=traitDate (args(2))

if args.count=4 then dateto=traitDate (args(3)) else dateto=traitDate(Date)

ext= traitext (lcase(args(1)))

if datefrom>dateto then
	mess= "dateto must be inferior than datefrom" &VBCRLF
	syntaxe mess
end if	

if ext<>"Exit"	then
	testfolder dest
end if

'--------------------------------------------------------------------
Function RegExpTest(ext, extension)
patrn=ext
strng=extension
RegExpTest=false
star=instr(patrn,"*")
if star<>0 then
	patrn=mid(patrn,1,star-1)
	if instr(strng,patrn)<>0 then RegExpTest=true
else
	if strng=patrn then'si on trouve dans lextension qu on veut supprimer, lextension du fichier sur lequel on est positionne
		'alors supprimer !!!
		RegExpTest=true
	end if
end if

End Function

'--------------------------------------------------------------------
Function swapDate(anc)
dd=mid(anc,1,2)
mm=mid(anc,4,2)
yyyy=mid(anc,7,4)
swapDate=yyyy&mm&dd
End Function

'--------------------------------------------------------------------
Sub testfolder(dossier)
If right(dossier,1)<>"\" Then dossier=dossier & "\"
Dim fs,collfolders,collfiles,folder,file, attrib
Set fs=fso.GetFolder(dossier)
'Exploration des sous-dossiers du dossier
For Each objSousRep in fs.SubFolders  
  Set collfiles=(fso.GetFolder(dossier & objSousRep.Name)).Files
  'Exploration des fichiers du dossier
  for each file in collfiles
  	curfile=file.name
  	p=instrrev(curfile,".")
  	If p>0 Then
  		extension=mid(curfile,p+1)
  	else
  		extension=""
  	end if
  	If  RegExpTest(ext,extension) Then
  	  'Choisir le type de date à filtrer
      s=swapDate(mid(file.DateCreated,1,10)) 
      's=swapDate(mid(file.DateLastAccessed,1,10)) 
  		's=swapDate(mid(file.DateLastModified,1,10))
  		If s<=dateto and s>=datefrom Then
  		  fso.DeleteFile(dossier & objSousRep.Name& "\"&curfile)
  		End If
  	end if
  next
  'Exploration des sous-dossiers du sous-dossier
  Call testfolder(dossier & objSousRep.Name)
next  
End Sub

'--------------------------------------------------------------------

Function traitDate(datelambda)
if mid(datelambda,1,5)="today" then
	if Instr(datelambda,"-")<>0 then
		datelambda=CDate(Date)-mid(datelambda,7)
	else
		datelambda=Date
	end if
else
	if Instr(datelambda,"-")<> 0 then
		if isDate(mid(datelambda,1,(Instr(datelambda,"-"))-1)) then
			datelambda=CDate(mid(datelambda,1,(Instr(datelambda,"-"))-1))- mid(datelambda,(Instr(datelambda,"-"))+1)
		end if
	end if
end if
if isDate(datelambda)=False then
	mess= "Wrong Date format"&VBCRLF
	syntaxe mess
end if
datelambda=swapDate(datelambda)
traitDate=datelambda
end Function

'--------------------------------------------------------------------
function traitext(arg)
If left(arg,1)="."Then
	ext1=mid(arg,2)
else
	if mid(arg,1,2)="*." then
		ext1=mid(arg,3)
	else
		if instr(arg,"*")=0 then
			if fso.FileExists(dest&arg)=false then
				mess= "the file doesn't exist" &VBCRLF
				syntaxe mess
			else
			        Set fs=fso.GetFile(dest&arg)
			                     'Choisir le type de date à filtrer
			                     s=swapDate(mid(fs.DateCreated,1,10))
	                       	 's=swapDate(mid(fs.DateLastAccessed,1,10))
                           's=swapDate(mid(fs.DateLastModified,1,10))
	                       	If s<=dateto and s>=datefrom Then
                                        'supprimer le fichier et finir le process
                                        fso.DeleteFile (dest&fs.name)
                                        ext1 = "Exit"
				end if
			end if
		else
			mess= "type of file wrong"  &VBCRLF
			syntaxe mess
		end if
	end if
end if
traitext=ext1
end function

'--------------------------------------------------------------------

Sub syntaxe(mess)
mess=mess & "Syntaxe :"  & VBCRLF
mess=mess & "   delobsolete <repertory> <extension> <date from> [<date to>]" & VBCRLF
mess=mess & "       repertory : initial repertory of the search" & VBCRLF
mess=mess & "                   (if there is some space put it in inverted commas)" & VBCRLF
mess=mess & "       extension : extension of files to delete" & VBCRLF
mess=mess & "                   - with a dot" & VBCRLF
mess=mess & "                   - can contain *"& VBCRLF
mess=mess & "       date from : date from which you want to delete the files DD/MM/YYYY" & VBCRLF
mess=mess & "       date to   : date to which you want to delete the files DD/MM/YYYY" & VBCRLF
mess=mess & "                   - in its absence today date" & VBCRLF
mess=mess & "Examples :"  & VBCRLF
mess=mess & "   delobsolete d:\winnt *.prn* 14/10/2004" & VBCRLF
mess=mess & "   delobsolete d:\winnt .prn today-23 today" & VBCRLF
wscript.echo mess
wscript.quit
End Sub

Conclusion :


Aucun bug repertorié pour le moment. Programme a utiliser avec parcimonie, les fichiers ne sont pas envoyés dans la corbeille mais vraiment supprimés définitivement.

Codes Sources

A voir également

Ajouter un commentaire Commentaire
Messages postés
17286
Date d'inscription
mercredi 2 janvier 2002
Statut
Modérateur
Dernière intervention
23 décembre 2019
67
j'aime pas du tout tes découpages de dates a coups de Mid$
bien trop aléatoires....

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.