I’ve created the script below, which manages and maintains allocated storage within a RootFolder, into which are stored daily backups each within its sown individual folder, and should the RootFolder content exceed a preset limit, then the oldest backup folder is then deleted.
So far so good . . . the problem I have is that largeish files may also be added to the RootFolder [strHomeFolder] and as such are also included in the total accumulated 'size'. As a consequence the backup folders may be prematurely deleted, and in the worst case scenario all may be deleted altogether, which unfortunately may somewhat defeat the purpose of having backups !
I am therefore seeking advice in makeing the objFSO.GetFolder check only the contents of all of the backup Folders located within the RootFolder whilst ignoring any of the files at that level.
strOldestFolder = ""
dtmOldestDate = Now
Set oShell = CreateObject("WScript.Shell")
strHomeFolder = oShell.ExpandEnvironmentStrings("%USERPROFILE%\HDBackups")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(strHomeFolder)
intFolderSize = Int((objFolder.Size / 1024) / 1024)
If intFolderSize >= 50 Then ' change as appropriate value in MBytes
Set objSubFolders = objFolder.SubFolders
For Each objFolder in objSubFolders
strFolder = objFolder.Path
dtmFolderDate = objFolder.DateCreated
If dtmFolderDate < dtmOldestDate Then
dtmOldestDate = dtmFolderDate
strOldestFolder = strFolder
End If
Next
objFSO.DeleteFolder(strOldestFolder)
End If
Just loop through the Root folder's SubFolders and sum up intFolderSize:
strOldestFolder = ""
dtmOldestDate = Now
Set objShell = CreateObject("WScript.Shell")
strHomeFolder = objShell.ExpandEnvironmentStrings("%USERPROFILE%\HDBackups")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(strHomeFolder)
Dim objSubFolder
intFolderSize = 0
For Each objSubFolder In objFolder.SubFolders
intFolderSize = intFolderSize + objSubFolder.Size
Next
intFolderSize = Int((intFolderSize / 1024) / 1024)
If intFolderSize >= 50 Then ' change as appropriate value in MBytes
Set objSubFolders = objFolder.SubFolders
For Each objFolder In objSubFolders
strFolder = objFolder.Path
dtmFolderDate = objFolder.DateCreated
If dtmFolderDate < dtmOldestDate Then
dtmOldestDate = dtmFolderDate
strOldestFolder = strFolder
End If
Next
objFSO.DeleteFolder (strOldestFolder)
End If
Related
I'm very new to bat scripting and would like to be able to do the following:
I have a main 'backups' folder which in turn contains unique folders for individual daily backups taken (i.e. named 'backup (date/time'). Within these individual daily backup folders they contain both files and folders.
I would therefore like to be able to check the main 'backups' folder and if the size is greater then say 50GB then the oldest folder and anything contained within is deleted.
I came across the script below in the Forum which does what I'm looking for, but on files rather then folders. Due to my elementally level of scripting, I'm not sure how straightforward it would be to adapt have it work with folders or if there is something else already available.
Many Thanks
Set fso = CreateObject("Scripting.FileSystemObject")
Set F = fso.GetFolder("C:\Users\User\Desktop\New Folder\Stories\Test")
If F.size > 2^30*2 Then
'Comments on a stupid editor that can't handle tabs
'Creating an in memory disconnected recordset to sort files by date
Set rs = CreateObject("ADODB.Recordset")
With rs
.Fields.Append "Date", 7
.Fields.Append "Txt", 201, 5000
.Open
For Each Thing in f.files
.AddNew
.Fields("Date").value = thing.datelastmodified
.Fields("Txt").value = thing.path
.UpDate
Next
.Sort = "Date Desc"
Do While not .EOF
fso.deletefile .Fields("Txt").Value
If f.size < 2^30*2 then Exit Do
.MoveNext
Loop
End With
End If
Here's code that does what you are looking for:
Dim objFSO
PurgeBackups "C:\Temp"
Sub PurgeBackups(p_sRootFolder)
Dim objRootFolder
Dim objOldestFolder
Dim fOldestInitialized
Dim objFolder
Dim lngFolderSize
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objRootFolder = objFSO.GetFolder(p_sRootFolder)
fOldestInitialized = False
For Each objFolder In objRootFolder.SubFolders
lngFolderSize = GetFolderSize(objFolder)
If lngFolderSize > 50000000000# Then
' Decide if you want to delete this Folder or not
If Not fOldestInitialized Then
Set objOldestFolder = objFolder
fOldestInitialized = True
End If
' Compare date
If objFolder.DateCreated < objOldestFolder.DateCreated Then
Set objOldestFolder = objFolder
End If
End If
Next
If fOldestInitialized Then
' Delete oldest folder
objOldestFolder.Delete
End If
End Sub
Function GetFolderSize(p_objFolder)
Dim objFile
Dim objFolder
Dim lngFolderSize
lngFolderSize = 0
For Each objFile In p_objFolder.Files
lngFolderSize = lngFolderSize + objFile.Size
Next
For Each objFolder In p_objFolder.SubFolders
lngFolderSize = lngFolderSize + GetFolderSize(objFolder)
Next
GetFolderSize = lngFolderSize
End Function
Please find below my attempt which has been based on an existing script and modified to suit, with a few extra flurries . . . I would be grateful for comment.
strOldestFolder = ""
dtmOldestDate = Now
Set oShell = CreateObject("WScript.Shell")
strHomeFolder = oShell.ExpandEnvironmentStrings("%USERPROFILE%\HDBackups")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(strHomeFolder)
intFolderSize = Int((objFolder.Size / 1024) / 1024)
If intFolderSize >= 50 Then ' change as appropriate, value in MBytes
Set objSubFolders = objFolder.SubFolders
For Each objFolder in objSubFolders
strFolder = objFolder.Path
dtmFolderDate = objFolder.DateCreated
If dtmFolderDate < dtmOldestDate Then
dtmOldestDate = dtmFolderDate
strOldestFolder = strFolder
End If
Next
objFSO.DeleteFolder(strOldestFolder)
End If
One aspect that I'm not entirely happy with is the look and neatness of the 'str' and 'Set' in the first six code lines, I would like to be group them together, i.e. all the Sets together. But so far have been unable to do so without the script failing.
Note: have used 50MB rather then the 50GB as per original description, makes testing a bit easier.
I currently have this VBScript, which checks the size of a folder, then deletes files (oldest first) until a threshold is reached.
Option Explicit
'use next line for production
On Error Resume Next
'use next line for debugging
'On Error GoTo 0
Dim strResult: strResult = Wscript.ScriptName
Dim objFSO, strOldestFile, dtmOldestDate, strFolder, oFolder, intFolderSize
Set objFSO = CreateObject("Scripting.FileSystemObject")
dtmOldestDate = Now
strFolder = "C:\Users\PLEX\Downloads\Torrent\"
strOldestFile = ""
Set oFolder = objFSO.GetFolder(strFolder)
intFolderSize = Int(((oFolder.Size / 1024) / 1024) / 1024)
Do While intFolderSize >= 110
strOldestFile = ""
dtmOldestDate = Now
FindOldestFile oFolder
'WScript.Echo strOldestFile
objFSO.DeleteFile strOldestFile, True
strResult = strResult & vbNewLine & dtmOldestDate & vbTab & strOldestFile
intFolderSize = Int(((oFolder.Size / 1024) / 1024) / 1024)
Loop
'WScript.Echo strResult
WScript.Quit
Sub FindOldestFile(objFolder)
Dim objFile, colFiles, colFolders, strFile, dtmFileDate
'find oldest file
Set colFiles = objFolder.Files
For Each objFile In colFiles
strFile = objFile.Path
dtmFileDate = objFile.DateCreated
If dtmFileDate < dtmOldestDate Then
dtmOldestDate = dtmFileDate
strOldestFile = strFile
End If
Next
'recurse subfolders
Set colFolders = objFolder.SubFolders
For Each objFile In colFolders
FindOldestFile objFile
Next
End Sub
Currently this script will:
Check the capacity of folder A including all subfolders.
Delete files (oldest first) from folder A and subfolders until a threshold is reached (in this case, 110GB)
I'd like to modify the script to do this:
Check the capacity of folder A including all subfolders.
Delete files (oldest first) from folder B (which is a subfolder of folder A) and subfolders until a threshold is reached.
For example, is it possible to get this script to check the used capacity of the entire C: drive and delete the oldest files from C:\Users\PLEX\Downloads\Torrent\ when there is less than 5% remaining on C:?
Edit: I already had full access, and fixed the error by changing C:\ to C: . I also changed C:\Users\PLEX\Desktop\New Folder to \Users\PLEX\Desktop\New Folder and am now getting no errors. The only problem is that IntFolderSize still shows the size of my subfolder, not the root. I've confirmed that by using Wscript.Echo intfoldersize. My current script is below. How can I get IntFolderSize to show the used size of the root?
option explicit
'use next line for production
'On Error Resume Next
'use next line for debugging
'On Error GoTo 0
Dim strResult: strResult = Wscript.ScriptName
Dim objFSO, strOldestFile, dtmOldestDate, strFolder, oFolder, intFolderSize
Set objFSO = CreateObject("Scripting.FileSystemObject")
dtmOldestDate = Now
strFolder = "C:"
strOldestFile = ""
Set oFolder = objFSO.GetFolder( strFolder)
intFolderSize = Int(((oFolder.Size / 1024) / 1024) / 1024)
Wscript.Echo intfoldersize
Do While intFolderSize >= 70
strOldestFile = ""
dtmOldestDate = Now
FindOldestFile objFSO.GetFolder(objFSO.BuildPath(strFolder,"\Users\PLEX\Desktop\New Folder\"))
'wscript.echo strOldestFile
objFSO.DeleteFile strOldestFile, True
strResult = strResult & vbNewLine & dtmOldestDate & vbTab & strOldestFile
intFolderSize = Int(((oFolder.Size / 1024) / 1024) / 1024)
Loop
'Wscript.Echo strResult
Wscript.Quit
Sub FindOldestFile( objFolder)
Dim objFile, colFiles, colFolders, strFile, dtmFileDate
' find oldest file
Set colFiles = objFolder.Files
For Each objFile in colFiles
strFile = objFile.Path
dtmFileDate = objFile.DateCreated
If dtmFileDate < dtmOldestDate Then
dtmOldestDate = dtmFileDate
strOldestFile = strFile
End If
Next
' recurse subfolders
Set colFolders = objFolder.SubFolders
For Each objFile in colFolders
FindOldestFile objFile
Next
End Sub
Change
FindOldestFile oFolder
into
FindOldestFile objFSO.GetFolder(objFSO.BuildPath(strFolder, "sub\folder"))
where strFolder is your root folder and "sub\folder" the relative path to the subfolder below that root folder.
Edit: Note that the oFolder.Size property will raise an error unless you have access to every single file and folder below oFolder. If you want to check the free diskspace on the volume anyway, you may be better off using WMI for that and using oFolder strictly for the folder you want to delete from:
strFolder = "C:\Users\PLEX\Desktop\New folder"
Set oFolder = objFSO.GetFolder(strFolder)
threshold = ... 'desired minimum free diskspace in byte
Set wmi = GetObject("winmgmts://./root/cimv2")
qry = "SELECT * FROM Win32_Volume WHERE DriveLetter='C:'"
Do While wmi.ExecQuery(qry).ItemIndex(0).FreeSpace < threshold
...
FindOldestFile oFolder
...
Loop
I am using the following code:
Set StorageFileSystem = CreateObject("Scripting.fileSystemObject")
Set StorageFolder = StorageFileSystem.GetFolder(PathToStorageFiles)
msgBox "Set folders for Storage"
for each Storagefile in StorageFolder.Files 'get the creation time of the oldest recording
msgBox "DateCreated: " & Storagefile.DateCreated & vbCrLf & "EarylDateTime: " & earlyDateTime & vbCrLf & "DateTime to compare: " & dateadd("h" ,-6, Now)
if Storagefile.DateCreated < dateadd("h" ,-6, Now) then
earlyDateTime = Storagefile.DateCreated
end if
next
I have used this before without problem, even in the program that this is in. However this time it never seems to do anything. The folder has over 130,000 files in it (391GB). I don't know if I should include a delay so that the program can emumerate them or if there is some other problem that I just don't see.
Any ideas? I'm using VBS, the msgBox between the 2 set statements and the for loop works, but the one between the opening of the for loop and the if statement does not.
Are you saying the codes in the For loop doesn't seem to work? It seems not work if the folder does not have any files in it. So check the value of PathToStorageFiles.
Your logic of getting the oldest recording creation time is flawed - any time that is 6 hours before Now is treated as oldest and set to earlyDateTime.
Try this code below, with sample output:
PathToStorageFiles = "C:\Test" ' <=- Change this!
Set StorageFileSystem = CreateObject("Scripting.fileSystemObject")
Set StorageFolder = StorageFileSystem.GetFolder(PathToStorageFiles)
sOldestFile = "" ' Stores the full name of the file
earlyDateTime = dateadd("h" ,-6, Now) ' Assuming 6 hours before script started is oldest (it can be just Now)
wscript.echo StorageFolder.Files.Count & " files in the folder " & PathToStorageFiles
for each Storagefile in StorageFolder.Files 'get the creation time of the oldest recording
if Storagefile.DateCreated < earlyDateTime then
sOldestFile = Storagefile.Path
earlyDateTime = Storagefile.DateCreated
wscript.echo "earlyDateTime changed to " & earlyDateTime & " | " & sOldestFile
end if
next
wscript.echo vbCrLf & "Oldest file: " & sOldestFile & vbCrLf & "Created on: " & earlyDateTime
On a side note, you should modify this to process sub folders too, then move files into folders. 130,000 files in a single folder is a mess!
UPDATE
Based on your posted solution, there are improvements you can do.
First, use 1 FileSystemObject.
Then the recentFile in the for loop. You should set it to zero first, rather than 2 comparisons. Having said that, you have the opportunity to time the differences.
recentFile = 0
For Each file in colFiles
If file.DateCreated > recentFile Then
recentFile = file.DateCreated
End If
Next
Lastly, if the D: on the server is a NAS, then you can split the code into 2 parts - one search for most recent, the other for oldest. Then use batch file start cscript.exe //nologo <script#.vbs> method to start them in 2 processes. This you need 2 txt files for output.
If there is only 1 folder to get the latest & oldest file, it can be in 1 for loop.
This is the code that I got to work:
Option Explicit
Dim LocalStorage, NewLocalStorage, recentFile, objFSO, colFiles, objFolder, file, OldestDate, strOldestDate, fso, ts, objFile
LocalStorage = "D:\BlueIris\Storage"
NewLocalStorage = "D:\BlueIris\New"
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(NewLocalStorage)
Set colFiles = objFolder.Files
For Each file in colFiles
If recentFile = "" Then
recentFile = file.DateCreated
ElseIf file.DateCreated > recentFile Then
recentFile = file.DateCreated
End If
Next
Set objFolder = objFSO.GetFolder(LocalStorage)
Set colFiles = objFolder.Files
OldestDate = Now
For Each objFile in colFiles
if objFile.DateCreated < OldestDate Then
OldestDate = objFile.DateCreated
strOldestDate = objFile.DateCreated
End if
Next
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.CreateTextFile ("C:\DVRInfo.txt", true)
ts.writeline recentFile
ts.writeline strOldestDate
ts.close
I run this on the actual server so that it runs a lot faster than the original code I attempted. Let me know if you still flaws in this please, I want to be as efficient as possible.
Thanks
EDIT:
New code:
Option Explicit
Dim LocalStorage, NewLocalStorage, recentFile, objFSO, colFiles, objFolder, file, OldestDate, strOldestDate, fso, ts, objFile
LocalStorage = "D:\BlueIris\Storage"
NewLocalStorage = "D:\BlueIris\New"
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(NewLocalStorage)
Set colFiles = objFolder.Files
Set recentFile = 0
For Each file in colFiles
If file.DateCreated > recentFile Then
recentFile = file.DateCreated
End If
Next
Set objFolder = objFSO.GetFolder(LocalStorage)
Set colFiles = objFolder.Files
OldestDate = Now
For Each objFile in colFiles
if objFile.DateCreated < OldestDate Then
OldestDate = objFile.DateCreated
strOldestDate = objFile.DateCreated
End if
Next
Set ts = fso.CreateTextFile ("C:\DVRInfo.txt", true)
ts.writeline recentFile
ts.writeline strOldestDate
ts.close
Hello again everybody!
I've been digging into .vb and .vbs. I have a small problem concerning renaming a file after copying it. From this (just giving credit where credit is due :p) person I've found how to copy the file to another folder, however I seem not to have been able to rename the file.
So I want to copy the file and rename the original to execute.HMS
This is the code for copying:
Set objFSo = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder("F:\commandfolder")
Set colFiles = objFolder.Files
dtmOldestDate = Now
For Each objFile in colFiles
If objFile.DateCreated < dtmOldestDate Then
dtmOldestDate = objFile.DateCreated
strOldestFile = objFile.Path
End If
Next
objFSO.CopyFile strOldestFile, "F:\commandfolder\Processed\"
Thanks in advance and kind regards,
Dave
VBScript doesn't provide a rename method for files. You have to use MoveFile instead:
objFSO.CopyFile strOldestFile, "F:\commandfolder\Processed\"
objFSO.MoveFile strOldestFile, objFSO.GetParentFolderName(strOldestFile) & "\execute.HMS"
A better option might be remembering the file object instead of just its path and then using the object's methods:
For Each objFile in colFiles
If objFile.DateCreated < dtmOldestDate Then
dtmOldestDate = objFile.DateCreated
Set oldestFile = objFile
End If
Next
oldestFile.Copy "F:\commandfolder\Processed\"
oldestFile.Name = "execute.HMS"
Based on this answer to a 'find' problem, I added code to move the file by using the file's Move method:
Const csSrcF = "..\testdata\17806396"
Const csDstF = "..\testdata\17806396\dst\"
Dim goFS : Set goFS = CreateObject( "Scripting.FileSystemObject" )
Dim oLstPng : Set oLstPng = Nothing
Dim oFile
For Each oFile In goFS.GetFolder(csSrcF).Files
If "png" = LCase(goFS.GetExtensionName(oFile.Name)) Then
If oLstPng Is Nothing Then
Set oLstPng = oFile ' the first could be the last
Else
If oLstPng.DateLastModified < oFile.DateLastModified Then
Set oLstPng = oFile
End If
End If
End If
Next
If oLstPng Is Nothing Then
WScript.Echo "no .png found"
Else
WScript.Echo "found", oLstPng.Name, oLstPng.DateLastModified
oLstPng.Move csDstF
If goFS.FileExists(goFS.BuildPath(csDstF, oLstPng.Name)) Then
WScript.Echo "Moved."
Else
WScript.Echo "Not moved."
End If
End If
This is my working solution (it's edited to the context but you'll figure it out if you need it :))
Set obj = CreateObject("Scripting.FileSystemObject")
Set objFSo = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder("F:\commandfolder")
Set colFiles = objFolder.Files
dtmOldestDate = Now
For Each objFile in colFiles
If objFile.DateCreated < dtmOldestDate Then
dtmOldestDate = objFile.DateCreated
strOldestFile = objFile.Path
End If
Next
objFSO.CopyFile strOldestFile, "F:\commandfolder\Processed\"
obj.DeleteFile("F:\commandfolder\Action\execute.hms")
objFSO.MoveFile strOldestFile, "F:\commandfolder\Action\execute.hms"
I have a folder which has certain subfolders..Now I want to find the subfolder which modified last ..Is there any function that I can use for this.
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objRootFolder = objFSO.GetFolder(FilePath)
Set colSubfolders = objRootFolder.SubFolders
For Each objFolder in colSubfolders
WScript.Echo objFolder
IF(objFolder.SubFolders.Count > 1 ) THEN
For Each fldr In objFolder.SubFolders
END If
NEXT
WScript.Echo LastFolder
WScript.Echo LastDate
END IF
NEXT
Set FSO= Nothing
Thanks
set lastFolder = nothing
lastTime = CDate("1900-01-01")
For Each fldr In objFolder.SubFolders
If fldr.DateLastModified > lastTime Then
Set lastFolder = fldr
lastTime = fldr.DateLastModified
End If
Next
WScript.Echo lastFolder.Name