VB, cancellare file vecchi?

[Paolosnz]

ciao
dovrei cancellare periodicamente dei file da una cartella, ad esempio tutti quelli che hanno più di due settimane,
ho trovato questo (http://windowsxp.mvps.org/wshdelfolder.htm) script che però cancella le dir...
qualcuno gentilmente saprebbe modificarlo in modo che cancelli i file? io non so programmare...
grazie a tutti :) a buon rendere ;)

[Stiwy.NET]

Dim i, fso, f, f1,f2, sf, BasePath, CalcResult, fNameArray()
BasePath = "D:\Reports"
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.GetFolder(BasePath)
Set sf = f.SubFolders
For Each f1 in sf
For Each f2 in f1.getFile 'Oppure una funzione simile,non ricordo
CalcResult = DateDiff("d",f1.DateCreated,Now)
if CalcResult > 2 then
ReDim preserve fNameArray(i)
fNameArray(i) = f1.Name
i = i + 1
end if
Next

For Each fName in fNameArray
FSO.DeleteFile(BasePath & "\" & fName)
Next

[Paolosnz]

grazie, ma mi da un errore "previsto next"

[mynos79]

Questo che ho appena fatto e provato, funziona:

' ATTENZIONE CHE I FILE SARANNO CANCELLATI DEFINITIVAMENTE
' NON ANDRANNO NEL CESTINO!!!


' directory principale (MODIFICARE IL PERCORSO)
path = "c:\AAA"

' cancella file più vecchi di 7 giorni (MODIFICARE IL N°)
killdate = date() - 7

arFiles = Array()
set fso = createobject("scripting.filesystemobject")

' sub che cancella i file; il 4° parametro indica se analizzare anche le sottodirectory
' se SI allora scrivere true, se NO allora scrivere false
SelectFiles path, killdate, arFiles, true

nDeleted = 0
for n = 0 to ubound(arFiles)
on error resume next
arFiles(n).delete true
if err.number <> 0 then
wscript.echo "Impossibile cancellare: " & arFiles(n).path
else
nDeleted = nDeleted + 1
end if
on error goto 0
next

msgbox nDeleted & " di " & ubound(arFiles)+1 & " file vecchi cancellati"

sub SelectFiles(sPath,vKillDate,arFilesToKill,bIncludeSubFolders)
on error resume next
set folder = fso.getfolder(sPath)
set files = folder.files

for each file in files
dtlastmodified = null
on error resume Next
dtlastmodified = file.datelastmodified
on error goto 0
if not isnull(dtlastmodified) Then
if dtlastmodified < vKillDate then
count = ubound(arFilesToKill) + 1
redim preserve arFilesToKill(count)
set arFilesToKill(count) = file
end if
end if
next

if bIncludeSubFolders then
for each fldr in folder.subfolders
SelectFiles fldr.path,vKillDate,arFilesToKill,true
next
end if
end sub

Modificare dove ho scritto ... ovvero il percorso della directory, il numero dei giorni e nella chiamata alla sub modificare il 4° parametro (true o false a seconda se si vuole analizzare anche le sottodirectory).
Salva il file come .vbs ...

[mynos79]

Dim i, fso, f, f1,f2, sf, BasePath, CalcResult, fNameArray()
BasePath = "D:\Reports"
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.GetFolder(BasePath)
Set sf = f.SubFolders
For Each f1 in sf
For Each f2 in f1.getFile 'Oppure una funzione simile,non ricordo
CalcResult = DateDiff("d",f1.DateCreated,Now)
if CalcResult > 2 then
ReDim preserve fNameArray(i)
fNameArray(i) = f1.Name
i = i + 1
end if
Next
Next

For Each fName in fNameArray
FSO.DeleteFile(BasePath & "\" & fName)
Next

Dimenticato il Next in grassetto ...

[Paolosnz]

Questo che ho appena fatto e provato, funziona:

' ATTENZIONE CHE I FILE SARANNO CANCELLATI DEFINITIVAMENTE
' NON ANDRANNO NEL CESTINO!!!


' directory principale (MODIFICARE IL PERCORSO)
path = "c:\AAA"

' cancella file più vecchi di 7 giorni (MODIFICARE IL N°)
killdate = date() - 7

arFiles = Array()
set fso = createobject("scripting.filesystemobject")

' sub che cancella i file; il 4° parametro indica se analizzare anche le sottodirectory
' se SI allora scrivere true, se NO allora scrivere false
SelectFiles path, killdate, arFiles, true

nDeleted = 0
for n = 0 to ubound(arFiles)
on error resume next
arFiles(n).delete true
if err.number <> 0 then
wscript.echo "Impossibile cancellare: " & arFiles(n).path
else
nDeleted = nDeleted + 1
end if
on error goto 0
next

msgbox nDeleted & " di " & ubound(arFiles)+1 & " file vecchi cancellati"

sub SelectFiles(sPath,vKillDate,arFilesToKill,bIncludeSubFolders)
on error resume next
set folder = fso.getfolder(sPath)
set files = folder.files

for each file in files
dtlastmodified = null
on error resume Next
dtlastmodified = file.datelastmodified
on error goto 0
if not isnull(dtlastmodified) Then
if dtlastmodified < vKillDate then
count = ubound(arFilesToKill) + 1
redim preserve arFilesToKill(count)
set arFilesToKill(count) = file
end if
end if
next

if bIncludeSubFolders then
for each fldr in folder.subfolders
SelectFiles fldr.path,vKillDate,arFilesToKill,true
next
end if
end sub

Modificare dove ho scritto ... ovvero il percorso della directory, il numero dei giorni e nella chiamata alla sub modificare il 4° parametro (true o false a seconda se si vuole analizzare anche le sottodirectory).
Salva il file come .vbs ...

sembra perfetto, si può togliere il messaggio che da quando cancella i file?

[mynos79]

Basta cancellare questa riga:

msgbox nDeleted & " di " & ubound(arFiles)+1 & " file vecchi cancellati"

Attento che c'è un altro messaggio poco sopra che viene fuori quando un file da cancellare è occupato dal sistema o da qualche applicazione e quindi impossibile da cancellare ... in caso lo vuoi togliere basta che cancelli le seguenti righe:

if err.number <> 0 then
wscript.echo "Impossibile cancellare: " & arFiles(n).path
else
nDeleted = nDeleted + 1
end if
Ma ti consiglio di tenere quest' ultimo ... tanto esce sulla console ... almeno in caso di errori sai quali file non ha cancellato.

[Paolosnz]

Basta cancellare questa riga:

msgbox nDeleted & " di " & ubound(arFiles)+1 & " file vecchi cancellati"

Attento che c'è un altro messaggio poco sopra che viene fuori quando un file da cancellare è occupato dal sistema o da qualche applicazione e quindi impossibile da cancellare ... in caso lo vuoi togliere basta che cancelli le seguenti righe:

if err.number <> 0 then
wscript.echo "Impossibile cancellare: " & arFiles(n).path
else
nDeleted = nDeleted + 1
end if
Ma ti consiglio di tenere quest' ultimo ... tanto esce sulla console ... almeno in caso di errori sai quali file non ha cancellato.

al primo ci ero arrivato ad intuito.. :)
ancora grazie mille e a buon rendere :D

[Paolosnz]

volevo utilizzare un singolo script da utilizzare su più
directory ma aggiungere un secondo percorso non funziona....
tipo
path = "c:\AAA"
path = "c:\BBB"

esegue l'operazione solo sulla dir BBB... è normale?

[mynos79]

E' normale :muro: :muro: :muro:
In quanto prima assegni alla variabile path la stringa "C:\AAA" e poi le riassegni la stringa C:\BBB ... in pratica gli sovrascrivi il valore e quindi lui considera solo il secondo.

Per passare più directory bisogna modificare il programma ...

[Paolosnz]

E' normale :muro: :muro: :muro:
In quanto prima assegni alla variabile path la stringa "C:\AAA" e poi le riassegni la stringa C:\BBB ... in pratica gli sovrascrivi il valore e quindi lui considera solo il secondo.

Per passare più directory bisogna modificare il programma ...

ok domanda da ignorante..

[mynos79]

' ATTENZIONE CHE I FILE SARANNO CANCELLATI DEFINITIVAMENTE
' NON ANDRANNO NEL CESTINO!!!

dim path()
' cambiare il numero con il numero massimo di percorsi inseriti
redim path(3)
' directory principale (MODIFICARE IL PERCORSO) e cambiare l'indice
' l'indice va da 0 al numero dei percorsi meno 1
path(0) = "c:\AAA"
path(1) = "c:\BBB"
path(2) = "c:\CCC"

' cancella file più vecchi di n giorni (MODIFICARE IL N°)
killdate = date() - 7

arFiles = Array()
set fso = createobject("scripting.filesystemobject")

for each p in path
' cambiare il 4° parametro con 'true' o 'false' se si vuole o meno
' ciclare le sottocirectory
SelectFiles p, killdate, arFiles, true
for n = 0 to ubound(arFiles)
on error resume next
arFiles(n).delete true
next
next

sub SelectFiles(sPath,vKillDate,arFilesToKill,bIncludeSubFolders)
on error resume next
set folder = fso.getfolder(sPath)
set files = folder.files

for each file in files
dtlastmodified = null
on error resume Next
dtlastmodified = file.datelastmodified
on error goto 0
if not isnull(dtlastmodified) Then
if dtlastmodified < vKillDate then
count = ubound(arFilesToKill) + 1
redim preserve arFilesToKill(count)
set arFilesToKill(count) = file
end if
end if
next

if bIncludeSubFolders then
for each fldr in folder.subfolders
SelectFiles fldr.path,vKillDate,arFilesToKill,true
next
end if
end sub

Programma modificato ...
Le righe da modificare stavolta sono queste:

redim path(3) --> cambiare il 3 con il numero dei percorsi usati
...
path(0) = "c:\AAA" --> cambiare sia il percorso tra virgolette che il numero tra parentesi (gli indici vanno da 0 a n-1)
path(1) = "c:\BBB"
path(2) = "c:\CCC"
...
killdate = date() - 7 --> cambiare il 7 col numero dei giorni
...
SelectFiles p, killdate, arFiles, true --> cambiare il true con true o false a seconda se si vuole controllare anche le varie sottodirectory

[mynos79]

Come vedi ho già tolto tutti i messaggi, anche quelli di errore visto che non ti servono.

[Paolosnz]

ma sei troppo gentile!!! se passi da milano hai una birra offerta ;)

[mynos79]

Eh eh ;) da buon veneto sempre disponibile alla bevuta ... potremmo invece sentirci per quella minimoto in vendita (ho un amico molto molto interessato che mi stressa da settimane per cercare qualche occasione su ebay o altrove). Tra oggi e domani ho modo di sentirlo e gli mostro la tua vendita; ti mando pvt se è interessato, magari ci passiamo il numero di telefono che ti chiama per maggiori informazioni. :cool:

[Paolosnz]

Eh eh ;) da buon veneto sempre disponibile alla bevuta ... potremmo invece sentirci per quella minimoto in vendita (ho un amico molto molto interessato che mi stressa da settimane per cercare qualche occasione su ebay o altrove). Tra oggi e domani ho modo di sentirlo e gli mostro la tua vendita; ti mando pvt se è interessato, magari ci passiamo il numero di telefono che ti chiama per maggiori informazioni. :cool:

ok quando vuoi...
ciao
Paolo :D