Hi,
Many thanks for this excellent program. I use it as a backup program; files
"deleted" to user-defined folders is a form of versioning.
In order to manage the deleted file, I wrote the below script that would
deleted files from the user-defined delete folders based on
1. The number of copies to keep
2. The time minimum different different between versions.
Pls use the below at your own risk.
Option explicit
Dim NoOfCopies
Dim MinTimeGapBetweentCopies
Dim TimeGapStep
' This script compliment FreeFileSync to purge the files deleted to user-defined directory.
' Credit to http://sogeeky.blogspot.com/2006/08/vbscript-using-disconnected-recordset.html where I learn ador.recordset
' and http://www.scriptinganswers.com/forum2/forum_posts.asp?TID=2099&PN=1 where I learn how to delete the files.
' and http://www.tek-tips.com/viewthread.cfm?qid=1472748&page=4 on processing named arg
'
' Parameters
'
' /Path: The user-defined directory defined within FreeFileSync
'
' /NoOfCopies: No of backup copies to keep
NoOfCopies=5
'
' /MinTimeGapBetweentCopies:
' The minimum time gap between copies. Default to 4 hours for the 2nd copies.
' See below if you want this in minutes or other units of measurement
MinTimeGapBetweentCopies=4
'
' /TimeGapStep:
' Time gap adj for subsequent copies. same unit of measurement as MinTimeGapsBetweentCopies
' Default to 2 hours.
' The time gap between 2nd and 3rd copy is MinTimeGapsBetweentCopie + TimeGapStep
' The time gap between 3rd and 4th copy is MinTimeGapsBetweentCopie + TimeGapStep + TimeGapStep
'
TimeGapStep=2
Dim fso, startFolder, rs
Set fso = CreateObject("Scripting.FileSystemObject")
' Default path to folder where the script is.
startFolder= fso.GetParentFolderName(Wscript.ScriptFullName)
Dim Args
'Process Argument
set Args = wScript.Arguments.Named
If Args.Exists("Path") Then
startFolder= Args.Item("Path")
end if
If Args.Exists("NoOfCopies") Then
NoOfCopies=Args.Item("NoOfCopies")
end if
If Args.Exists("MinTimeGapBetweentCopieps") Then
MinTimeGapBetweentCopies=Args.Item("MinTimeGapBetweentCopies")
end if
If Args.Exists("TimeGapStep") Then
TimeGapStep=Args.Item("TimeGapStep")
end if
Const adVarChar = 200
Const adDate = 7
Const adBSTR = 8
Const adDouble = 5
Const MaxCharacters = 255
Const adNumeric=131
set rs = createobject("ador.recordset")
with rs.fields
.append "FileNameFullPath",adVarChar , MaxCharacters
.append "FileName",adVarChar , MaxCharacters
.append "FileAge",adDouble
end with
rs.open
''Collect file records
GetFilesRecords startFolder
rs.Sort = "FileName,FileAge ASC" ' DESC/ASC
rs.MoveFirst
'Purge files---------------
Dim f , copies, BaseAge, DeletedCopies, LogFile
Dim del
f=""
copies=0
DeletedCopies=0
' ForAppending = 8 ForReading = 1, ForWriting = 2
Set LogFile = fso.OpenTextFile(startFolder&"\DelOldFile.log", 8, True)
LogFile.WriteLine("Purge "&startFolder&" on "&Date&" "&time)
Do Until rs.EOF
del=False
if NOT (rs.Fields.Item("FileName") = f) then
if NOT f="" then
LogFile.WriteLine(f&" Backup:"&copies+1&" Deleted:"&DeletedCopies) ' & vbCRLF
end if
f=rs.Fields.Item("FileName")
copies=0
DeletedCopies=0
BaseAge=rs.Fields.Item("FileAge")
else
'Same file name
if (rs.Fields.Item("FileAge")-BaseAge) > MinTimeGapBetweentCopies+copies*TimeGapStep then
'Time gap si wider than min
copies=copies+1
BaseAge=rs.Fields.Item("FileAge")
'Keep file unless > min copies
if copies>=NoOfCopies then
' WScript.Echo "Will delete "& rs.Fields.Item("FileNameFullPath")
' uncomment below to delete file.
' WARNING:!!!This will not go to recycle bin
fso.DeleteFile(rs.Fields.Item("FileNameFullPath"))
DeletedCopies=DeletedCopies+1
del=True
end if
else
' WScript.Echo "Will delete "& rs.Fields.Item("FileNameFullPath")
' uncomment below to delete file.
' WARNING:!!!This will not go to recycle bin
fso.DeleteFile(rs.Fields.Item("FileNameFullPath"))
DeletedCopies=DeletedCopies+1
del=True
end if
End if
' WScript.Echo rs.Fields.Item("FileName") _
' & vbTab & rs.Fields.Item("FileAge") _
' & vbTab & del _
' & vbTab & rs.Fields.Item("FileNameFullPath")
rs.MoveNext
Loop
LogFile.WriteLine("Purge "&startFolder&" ended on "&Date&" "&time) & vbCRLF
'------------------------
Function GetFilesRecords(folderName)
Dim folder, file, fileCollection, folderCollection, subFolder
Dim FileRelPath
Set folder = fso.GetFolder(folderName)
Set fileCollection = folder.Files
For Each file In fileCollection
FileRelPath=right(file.Path,len(file.Path)-len(startFolder)-2)
rs.addnew
rs("FileNameFullPath").Value=CStr(file.Path)
rs("FileName").Value=CStr(right(FileRelPath,len(FileRelPath)-instr(FileRelPath,"\")+1))
'Replace "h" with
'"d" for timegap in Days,
'"m" for Months,
'"h" for hour
'"n" for minutes
rs("FileAge").Value=DateDiff("h",file.DateLastModified,Now)
rs.update
Next
Set folderCollection = folder.SubFolders
For Each subFolder In folderCollection
' Add a simple check to ensure that the start folder is correct.
' FreeFileSync folder is named as yyyy-mm-dd tttttt
If Not mid(subFolder.Path,len(subFolder.Path)-6,1)=" " then
wscript.echo subFolder.Path&" does not look like a folder from FreeFileSync"
wscript.quit
End if
GetFilesRecords subFolder.Path
' Delete empty folders
If fso.getfolder(subFolder.Path).SubFolders.Count = 0 AND fso.getfolder(subFolder.Path).Files.Count = 0 Then
fso.DeleteFolder(subFolder.Path)
End If
Next
End Function
Manage files deleted to user-defined folders
- Posts: 7
- Joined: 12 Oct 2010
- Posts: 7
- Joined: 12 Oct 2010
Hopefully, the below loos better.
---------------
Option explicit
Dim NoOfCopies
Dim MinTimeGapBetweentCopies
Dim TimeGapStep
' This script compliment FreeFileSync to purge the files deleted to user-
defined directory.
' Credit to http://sogeeky.blogspot.com/2006/08/vbscript-using-disconnected-recordset.html where I learn ador.recordset
' and http://www.scriptinganswers.com/forum2/forum_posts.asp?TID=2099&PN=1 where I
learn how to delete the files.
' and http://www.tek-tips.com/viewthread.cfm?qid=1472748&page=4 on processing named arg
'
' Parameters
'
' /Path: The user-defined directory defined within FreeFileSync
'
' /NoOfCopies: No of backup copies to keep
NoOfCopies=5
'
' /MinTimeGapBetweentCopies:
' The minimum time gap between copies. Default to 4 hours for the 2nd copies.
' See below if you want this in minutes or other units of measurement
MinTimeGapBetweentCopies=4
'
' /TimeGapStep:
' Time gap adj for subsequent copies. same unit of measurement as
MinTimeGapsBetweentCopies
' Default to 2 hours.
' The time gap between 2nd and 3rd copy is MinTimeGapsBetweentCopie +
TimeGapStep
' The time gap between 3rd and 4th copy is MinTimeGapsBetweentCopie +
TimeGapStep + TimeGapStep
'
TimeGapStep=2
Dim fso, startFolder, rs
Set fso = CreateObject("Scripting.FileSystemObject")
' Default path to folder where the script is.
startFolder= fso.GetParentFolderName(Wscript.ScriptFullName)
Dim Args
'Process Argument
set Args = wScript.Arguments.Named
If Args.Exists("Path") Then
startFolder= Args.Item("Path")
end if
If Args.Exists("NoOfCopies") Then
NoOfCopies=Args.Item("NoOfCopies")
end if
If Args.Exists("MinTimeGapBetweentCopieps") Then
MinTimeGapBetweentCopies=Args.Item("MinTimeGapBetweentCopies")
end if
If Args.Exists("TimeGapStep") Then
TimeGapStep=Args.Item("TimeGapStep")
end if
Const adVarChar = 200
Const adDate = 7
Const adBSTR = 8
Const adDouble = 5
Const MaxCharacters = 255
Const adNumeric=131
set rs = createobject("ador.recordset")
with rs.fields
.append "FileNameFullPath",adVarChar , MaxCharacters
.append "FileName",adVarChar , MaxCharacters
.append "FileAge",adDouble
end with
rs.open
''Collect file records
GetFilesRecords startFolder
rs.Sort = "FileName,FileAge ASC" ' DESC/ASC
rs.MoveFirst
'Purge files---------------
Dim f , copies, BaseAge, DeletedCopies, LogFile
Dim del
f=""
copies=0
DeletedCopies=0
' ForAppending = 8 ForReading = 1, ForWriting = 2
Set LogFile = fso.OpenTextFile(startFolder&"\DelOldFile.log", 8, True)
LogFile.WriteLine("Purge "&startFolder&" on "&Date&" "&time)
Do Until rs.EOF
del=False
if NOT (rs.Fields.Item("FileName") = f) then
if NOT f="" then
LogFile.WriteLine(f&" Backup:"&copies+1&" Deleted:"&DeletedCopies) ' & vbCRLF
end if
f=rs.Fields.Item("FileName")
copies=0
DeletedCopies=0
BaseAge=rs.Fields.Item("FileAge")
else
'Same file name
if (rs.Fields.Item("FileAge")-BaseAge) >
MinTimeGapBetweentCopies+copies*TimeGapStep then
'Time gap si wider than min
copies=copies+1
BaseAge=rs.Fields.Item("FileAge")
'Keep file unless > min copies
if copies>=NoOfCopies then
' WScript.Echo "Will delete "& rs.Fields.Item("FileNameFullPath")
' uncomment below to delete file.
' WARNING:!!!This will not go to recycle bin
fso.DeleteFile(rs.Fields.Item("FileNameFullPath"))
DeletedCopies=DeletedCopies+1
del=True
end if
else
' WScript.Echo "Will delete "& rs.Fields.Item("FileNameFullPath")
' uncomment below to delete file.
' WARNING:!!!This will not go to recycle bin
fso.DeleteFile(rs.Fields.Item("FileNameFullPath"))
DeletedCopies=DeletedCopies+1
del=True
end if
End if
' WScript.Echo rs.Fields.Item("FileName") _
' & vbTab & rs.Fields.Item("FileAge") _
' & vbTab & del _
' & vbTab & rs.Fields.Item("FileNameFullPath")
rs.MoveNext
Loop
LogFile.WriteLine("Purge "&startFolder&" ended on "&Date&" "&time) & vbCRLF
'------------------------
Function GetFilesRecords(folderName)
Dim folder, file, fileCollection, folderCollection, subFolder
Dim FileRelPath
Set folder = fso.GetFolder(folderName)
Set fileCollection = folder.Files
For Each file In fileCollection
FileRelPath=right(file.Path,len(file.Path)-len(startFolder)-2)
rs.addnew
rs("FileNameFullPath").Value=CStr(file.Path)
rs("FileName").Value=CStr(right(FileRelPath,len(FileRelPath)-instr(FileRelPath
,"\")+1))
'Replace "h" with
'"d" for timegap in Days,
'"m" for Months,
'"h" for hour
'"n" for minutes
rs("FileAge").Value=DateDiff("h",file.DateLastModified,Now)
rs.update
Next
Set folderCollection = folder.SubFolders
For Each subFolder In folderCollection
' Add a simple check to ensure that the start folder is correct.
' FreeFileSync folder is named as yyyy-mm-dd tttttt
If Not mid(subFolder.Path,len(subFolder.Path)-6,1)=" " then
wscript.echo subFolder.Path&" does not look like a folder from FreeFileSync"
wscript.quit
End if
GetFilesRecords subFolder.Path
' Delete empty folders
If fso.getfolder(subFolder.Path).SubFolders.Count = 0 AND
fso.getfolder(subFolder.Path).Files.Count = 0 Then
fso.DeleteFolder(subFolder.Path)
End If
Next
End Function
-------------
---------------
Option explicit
Dim NoOfCopies
Dim MinTimeGapBetweentCopies
Dim TimeGapStep
' This script compliment FreeFileSync to purge the files deleted to user-
defined directory.
' Credit to http://sogeeky.blogspot.com/2006/08/vbscript-using-disconnected-recordset.html where I learn ador.recordset
' and http://www.scriptinganswers.com/forum2/forum_posts.asp?TID=2099&PN=1 where I
learn how to delete the files.
' and http://www.tek-tips.com/viewthread.cfm?qid=1472748&page=4 on processing named arg
'
' Parameters
'
' /Path: The user-defined directory defined within FreeFileSync
'
' /NoOfCopies: No of backup copies to keep
NoOfCopies=5
'
' /MinTimeGapBetweentCopies:
' The minimum time gap between copies. Default to 4 hours for the 2nd copies.
' See below if you want this in minutes or other units of measurement
MinTimeGapBetweentCopies=4
'
' /TimeGapStep:
' Time gap adj for subsequent copies. same unit of measurement as
MinTimeGapsBetweentCopies
' Default to 2 hours.
' The time gap between 2nd and 3rd copy is MinTimeGapsBetweentCopie +
TimeGapStep
' The time gap between 3rd and 4th copy is MinTimeGapsBetweentCopie +
TimeGapStep + TimeGapStep
'
TimeGapStep=2
Dim fso, startFolder, rs
Set fso = CreateObject("Scripting.FileSystemObject")
' Default path to folder where the script is.
startFolder= fso.GetParentFolderName(Wscript.ScriptFullName)
Dim Args
'Process Argument
set Args = wScript.Arguments.Named
If Args.Exists("Path") Then
startFolder= Args.Item("Path")
end if
If Args.Exists("NoOfCopies") Then
NoOfCopies=Args.Item("NoOfCopies")
end if
If Args.Exists("MinTimeGapBetweentCopieps") Then
MinTimeGapBetweentCopies=Args.Item("MinTimeGapBetweentCopies")
end if
If Args.Exists("TimeGapStep") Then
TimeGapStep=Args.Item("TimeGapStep")
end if
Const adVarChar = 200
Const adDate = 7
Const adBSTR = 8
Const adDouble = 5
Const MaxCharacters = 255
Const adNumeric=131
set rs = createobject("ador.recordset")
with rs.fields
.append "FileNameFullPath",adVarChar , MaxCharacters
.append "FileName",adVarChar , MaxCharacters
.append "FileAge",adDouble
end with
rs.open
''Collect file records
GetFilesRecords startFolder
rs.Sort = "FileName,FileAge ASC" ' DESC/ASC
rs.MoveFirst
'Purge files---------------
Dim f , copies, BaseAge, DeletedCopies, LogFile
Dim del
f=""
copies=0
DeletedCopies=0
' ForAppending = 8 ForReading = 1, ForWriting = 2
Set LogFile = fso.OpenTextFile(startFolder&"\DelOldFile.log", 8, True)
LogFile.WriteLine("Purge "&startFolder&" on "&Date&" "&time)
Do Until rs.EOF
del=False
if NOT (rs.Fields.Item("FileName") = f) then
if NOT f="" then
LogFile.WriteLine(f&" Backup:"&copies+1&" Deleted:"&DeletedCopies) ' & vbCRLF
end if
f=rs.Fields.Item("FileName")
copies=0
DeletedCopies=0
BaseAge=rs.Fields.Item("FileAge")
else
'Same file name
if (rs.Fields.Item("FileAge")-BaseAge) >
MinTimeGapBetweentCopies+copies*TimeGapStep then
'Time gap si wider than min
copies=copies+1
BaseAge=rs.Fields.Item("FileAge")
'Keep file unless > min copies
if copies>=NoOfCopies then
' WScript.Echo "Will delete "& rs.Fields.Item("FileNameFullPath")
' uncomment below to delete file.
' WARNING:!!!This will not go to recycle bin
fso.DeleteFile(rs.Fields.Item("FileNameFullPath"))
DeletedCopies=DeletedCopies+1
del=True
end if
else
' WScript.Echo "Will delete "& rs.Fields.Item("FileNameFullPath")
' uncomment below to delete file.
' WARNING:!!!This will not go to recycle bin
fso.DeleteFile(rs.Fields.Item("FileNameFullPath"))
DeletedCopies=DeletedCopies+1
del=True
end if
End if
' WScript.Echo rs.Fields.Item("FileName") _
' & vbTab & rs.Fields.Item("FileAge") _
' & vbTab & del _
' & vbTab & rs.Fields.Item("FileNameFullPath")
rs.MoveNext
Loop
LogFile.WriteLine("Purge "&startFolder&" ended on "&Date&" "&time) & vbCRLF
'------------------------
Function GetFilesRecords(folderName)
Dim folder, file, fileCollection, folderCollection, subFolder
Dim FileRelPath
Set folder = fso.GetFolder(folderName)
Set fileCollection = folder.Files
For Each file In fileCollection
FileRelPath=right(file.Path,len(file.Path)-len(startFolder)-2)
rs.addnew
rs("FileNameFullPath").Value=CStr(file.Path)
rs("FileName").Value=CStr(right(FileRelPath,len(FileRelPath)-instr(FileRelPath
,"\")+1))
'Replace "h" with
'"d" for timegap in Days,
'"m" for Months,
'"h" for hour
'"n" for minutes
rs("FileAge").Value=DateDiff("h",file.DateLastModified,Now)
rs.update
Next
Set folderCollection = folder.SubFolders
For Each subFolder In folderCollection
' Add a simple check to ensure that the start folder is correct.
' FreeFileSync folder is named as yyyy-mm-dd tttttt
If Not mid(subFolder.Path,len(subFolder.Path)-6,1)=" " then
wscript.echo subFolder.Path&" does not look like a folder from FreeFileSync"
wscript.quit
End if
GetFilesRecords subFolder.Path
' Delete empty folders
If fso.getfolder(subFolder.Path).SubFolders.Count = 0 AND
fso.getfolder(subFolder.Path).Files.Count = 0 Then
fso.DeleteFolder(subFolder.Path)
End If
Next
End Function
-------------
