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 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]

Originariamente inviato da 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
Next

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

Dimenticato il Next in grassetto ...

[Paolosnz]

Originariamente inviato da 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 ...

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]

Originariamente inviato da 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.

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

[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
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]

Originariamente inviato da mynos79

E' normale
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.

[Paolosnz]

Originariamente inviato da 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.

ok quando vuoi...
ciao
Paolo