schonen bestanden uit map naar datum

Status
Niet open voor verdere reacties.

athestreet

Gebruiker
Lid geworden
13 nov 2006
Berichten
77
Hallo,

Ik ben op zoek naar iets om in een bepaalde map alle soorten bestanden te laten verwijderen die bijvoorbeeld ouder zijn dan 30 dagen. Het liefst met excel en vba denk ik.

Ik heb wat gevonden, maar doet het niet geeft aan 0 files verwijderd terwijl deze toch ouder zijn. Omdat we op het netwerk werken mogen we geen scripts gebruiken, maar omdat excel met vba het wel doet zou hier de oplossing.

Ik heb dit als module in excel geplaatst. Ik denk dat het niet wil omdat er geen mappen kan worden aangemaakt. Ik heb zelf verder geen kennis hiervan dus kan ook niet zoveel hiervan begrijpen.
-----------------------------------------------------
' directories om te schonen...
Path = "c:\test"

' delete files ouder dan bijvoorbeeld 30 dagen...
killdate = Date() - 30

arFiles = Array()
Set fso = CreateObject("scripting.filesystemobject")

' Niet weggooien als er nog mensen gebruik maken van de file
' file verzameling krijgt een return van File System Object (FSO).
' File verzameling kan vastlopen.
' Aparte plaats wordt gemaakt voor deze files.
'
SelectFiles Path, killdate, arFiles, True

nDeleted = 0
For n = 0 To UBound(arFiles)
'=================================================
' Files die weggegooid via FSO methode KOMEN *NIET* IN DE PRULLENBAK!!!
'=================================================
On Error Resume Next 'in case of 'in use' files...
arFiles(n).Delete True
If Err.Number <> 0 Then
wscript.echo "Unable to delete: " & arFiles(n).Path
Else
nDeleted = nDeleted + 1
End If
On Error GoTo 0
Next

'Onderstaande 2 regels geven op beeldscherm aan hoeveel files er zijn geschoond.
MsgBox nDeleted & " of " & UBound(arFiles) + 1 _
& " aantal files zijn weggegooid"

End Sub
Sub SelectFiles(sPath, vKillDate, arFilesToKill, bIncludeSubFolders)
On Error Resume Next
'selecteer files om weg te gooien of verplaats ze naar een plek...
'
Set folder = fso.getfolder(sPath)
Set Files = folder.Files

For Each file In Files

' Juiste datum wordt hier getest
'
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
' Hier gaat het volgens excel fout "For lus"
Next


If bIncludeSubFolders Then
For Each fldr In folder.subfolders
SelectFiles fldr.Path, vKillDate, arFilesToKill, True
Next
End If
End Sub
 
Laatst bewerkt:
Lijkt me voldoende zo:

Code:
Sub M_snb()
   c00 = "G:\OF\"
   c01 = Dir(c00 & "*.*")
   
   Do Until c01 = ""
      If Date - FileDateTime(c00 & c01) > 30 Then Kill c00 & c01
   Loop
End Sub
 
Lijkt me voldoende zo:

Code:
Sub M_snb()
   c00 = "G:\OF\"
   c01 = Dir(c00 & "*.*")
   
   Do Until c01 = ""
      If Date - FileDateTime(c00 & c01) > 30 Then Kill c00 & c01
   Loop
End Sub


Bedankt ziet er zeer goed uit. Het klopt toch dat ik hierbij alleen de 2de regel moet aanpassen in bijvoorbeeld c:\test\. Krijg namelijk nog een melding van
Sub M_snb()
c00 = "c:\test"
c01 = Dir(c00 & "*.*")

Do Until c01 = ""
If Date - FileDateTime(c00 & c01) > 30 Then Kill c00 & c01
Loop
End Sub

Krijg een melding bij regel If Date- aan het eind?
Knipsel.PNG

daarna geen melding maar helaas worden er ook geen bestanden verwijderd.
 

Bijlagen

  • Knipsel.PNG
    Knipsel.PNG
    39,6 KB · Weergaven: 54
Laatst bewerkt:
Je kunt ook zelf de inhoud van de melding lezen; daar heb je ons niet voor nodig.
 
En geen CODE tags gebruiken, én nodeloos complete berichten quoten.... heb je de forum regels wel eens gelezen?
 
In je plaatje heb je spaties op 4 heel vreemde plekken staan.
Gebruik daarnaast niet een + voor het aan elkaar plakken van strings maar het & teken.
 
Laatst bewerkt:
Oftewel: neem codes van snb letterlijk over (met aanpassing van de paden uiteraard) want er is een geringe kans dat hij het beter weet dan jij :d
 
En sla het bestand met de macro niet op in de directory waarin je gaat zoeken.
 
Helaas lukt het me niet. Systeembeheer gevraagd en men zegt dat het door netwerk komt. Geen rechten hierop. Ik wil u allen hartelijk danken voor het meedenken. Ik heb fotoprint gecorrigeerd. Mijn letterfont kan ik nu gelukkig aanpassen.
 
Vreemd. "Ik heb zelf verder geen kennis hiervan dus kan ook niet zoveel hiervan begrijpen." Zijn we met z'n tweeën!
Je hebt dan blijkbaar beperkte rechten en bent niet bevoegd om dergelijke handelingen überhaupt uit te voeren. Maar goed je zou nog eens kunnen kijken naar de zoekmachine Everything van Voidtools deze kan zoeken op extensie en datums modified/created etc.
Daar kun je een evt. een filter voor maken.
voorbeeld zoekopdracht:
Code:
[B]ext:docx dm:01/1/2020-31/12/2020[/B]
Zelf eerst een beetje studie van maken.
 
Wijzig C:\Test dan eens naar een locatie waar je wel lees- en schrijfrechten hebt.
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan