VBScript to get directory size if over N GB then delete oldest 'Folder' to recover space - vbscript

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.

Related

Getting the Folder size for only subfolders, whist ignoring any other content?

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

VBS - Transfer oldest file every 2 minutes

I found some similar threads but they didn't solve the full problem i'm having, first, i'm a complete amatour when it comes to VBS, so i'm sorry if this is a simple problem.
I need to build a vbscript that transfers the oldest file from folder A to B every 2 minutes, this is what i come up with:
Dim colFiles
Dim strStartFolder
Dim strDestinationfolder
Dim oOldestFile
Dim oFile
Dim oFSO
strStartFolder = "C:\Users\lucas\Desktop\a\"
strDestinationfolder = "C:\Users\lucas\Desktop\b\"
I=0
Do While I=0
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set colFiles = oFSO.GetFolder(strStartFolder).Files
If colFiles.Count <= 1 Then
WScript.Quit
End If
For Each oFile In colFiles
If Not IsObject(oOldestFile) Then
Set oOldestFile = oFile
Else
If oFile.DateLastModified < oOldestFile.DateLastModified Then
Set oOldestFile = oFile
End If
End If
Next
Do While i=0
oOldestFile.Move strDestinationfolder & "\" & oOldestFile.Name
Wscript.Sleep (2000)
Loop
At the moment, the vbscript only tranfer the oldest file one time.
Can someone please help me with this ?
Thank you !
EDIT:
after the suggestions made by Hackoo and GJKH, the script looks like this :
Option Explicit
Dim colFiles
Dim strStartFolder
Dim strDestinationfolder
Dim oOldestFile
Dim oFile
Dim oFSO
strStartFolder = "C:\Users\lucas\Desktop\a\"
strDestinationfolder = "C:\Users\lucas\Desktop\b\"
Do
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set colFiles = oFSO.GetFolder(strStartFolder).Files
Wscript.echo colFiles.Count
For Each oFile In colFiles
If Not IsObject(oOldestFile) Then
Set oOldestFile = oFile
Else
If oFile.DateLastModified < oOldestFile.DateLastModified Then
Set oOldestFile = oFile
End If
End If
Next
oOldestFile.Move strDestinationfolder & "\" & oOldestFile.Name
' Pause 1 ' sleep for 2 minutes
Set oFSO = nothing
Set colFiles = nothing
Loop
'****************************************************************
Sub Pause(min)
wscript.sleep(min * 60 * 1000)
End Sub
'****************************************************************
He transfer the first file and than loops ( activated ECHO ) but he does not transfer any more files after the first one, any ideas ?
I know more about vb.net than vbs but a couple of things strike me as odd that may be causing problems here...
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set colFiles = oFSO.GetFolder(strStartFolder).Files
I would destroy these and recreate them each time it loops, in vb.net you would just set oFSO = nothing and colFiles = nothing, I'm sure the syntax is similar in vbscript.
If colFiles.Count <= 1 Then
WScript.Quit
I take it there is more than one file in the folder after you move the oldest one - because if not then script exits here.
Wscript.Sleep (2000)
This method parameter is in milliseconds, if you want to update every 2 minutes this will need to be Wscript.Sleep(120000), setting it to 2000 would be every 2 seconds.
Try like that :
Option Explicit
Dim colFiles
Dim strStartFolder
Dim strDestinationfolder
Dim oOldestFile
Dim oFile
Dim oFSO
strStartFolder = "C:\Users\lucas\Desktop\a\"
strDestinationfolder = "C:\Users\lucas\Desktop\b\"
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set colFiles = oFSO.GetFolder(strStartFolder).Files
'Wscript.echo colFiles.Count
Do
'Wscript.echo colFiles.Count
If colFiles.Count <= 1 Then
'Wscript.echo colFiles.Count
WScript.Quit
End If
For Each oFile In colFiles
If Not IsObject(oOldestFile) Then
Set oOldestFile = oFile
Else
If oFile.DateLastModified < oOldestFile.DateLastModified Then
Set oOldestFile = oFile
End If
End If
Next
oOldestFile.Move strDestinationfolder & "\" & oOldestFile.Name
Pause 2 ' sleep for 2 minutes
Loop
'****************************************************************
Sub Pause(min)
wscript.sleep(min * 60 * 1000)
End Sub
'****************************************************************

Asking for a little assistance with cleanup and error

I have been given a task of creating a script that takes a log file (date is in the filename), pulls the data and posts it in event manager. I have a script that works as it should I know the script is ugly so please be gentle. I'm looking for 2 things.
some days nothing has happened and no log for the day was created. when this happens my script causes all kinds of slowness in the PC. I need help with a way for the script to not do its task if no new file has been added to the logs folder.
I would like a little help cleaning up the script.
Like i said i'm very new to this and i used scripts found on the web and fit them to do what i needed them to do.
any help would be greatly appricated.
Option Explicit
Const ForReading = 1
Dim strfolder
Dim FSO
Dim FLD
Dim fil
Dim strOldName
Dim strNewName
Dim strFileParts
Dim objShell
Dim objFSO
Dim objFolder
Dim strFileName
Dim objFile
Dim objTextFile
Dim strNextLine
Dim arrServiceList
Dim i
strFolder = "C:\Logs\"
Set objShell = CreateObject ("Wscript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.Namespace(strFolder)
Set objShell = CreateObject ("Wscript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objTextFile = objFSO.OpenTextFile ("C:\Logs\logCatchAll.log", ForReading)
For Each strFileName in objFolder.Items
If len(objFSO.GetExtensionName(strFileName)) > 0 Then
Set objFile = objFSO.GetFile(strFolder & strFileName.Name)
If DateDiff("H",objFile.DateLastModified,Now()) > 24 Then
objFSO.DeleteFile(strFolder & strFileName.Name),True
End If
End If
next
Set FSO = CreateObject("Scripting.FileSystemObject")
Set FLD = FSO.GetFolder(strfolder)
For Each fil in FLD.Files
strOldName = fil.Path
If InStr(strOldName, "-") > 0 Then
strFileParts = Split(strOldName, "-")
strNewName = strFileParts(0) & ".log"
FSO.MoveFile strOldName, strNewName
End If
Next
Set FLD = Nothing
Set FSO = Nothing
Do Until objTextFile.AtEndOfStream
strNextLine = objTextFile.Readline
arrServiceList = Split(strNextLine , ",")
For i = 3 to Ubound(arrServiceList)
objshell.LogEvent 4, arrServiceList(i)
Loop
You can block your Dim'd variables
You are reactivating the objShell to many times
You have a for loop at the bottom of your code without a Next statement.
You don't need to iterate through the log file until it reaches AtEndOfStream, just store it in a variable first.
You can use the same objFSO more than once if your not resetting the object.
You need to include error handling so you know where your code breaks.
Revised code.
Option Explicit
'Handle errors manually.
On Error Resume Next
'Set Constants
Const ForReading = 1
'Set Strings
Dim strFolder, strOldName, strNewName, strFileName, strFileParts, strNextLine, TFStrings
strFolder = "C:\Logs\"
'Set Objects
Dim objShell, objFSO, objFolder, objFile, objTextFile
Set objShell = CreateObject ("Wscript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objShell.Namespace(strFolder)
TFStrings = split(objFSO.OpenTextFile("C:\Logs\logCatchAll.log", ForReading).ReadAll, vbcrlf)
'Set Other Variables
Dim FLD, fil, arrServiceList, i, executed
executed = false
'Delete file procedure...
For Each strFileName in objFolder.Items
If len(objFSO.GetExtensionName(strFileName)) > 0 Then
Set objFile = objFSO.GetFile(strFolder & strFileName.Name)
If DateDiff("H",objFile.DateLastModified,Now()) > 24 Then
objFSO.DeleteFile(strFolder & strFileName.Name),True
executed = true
End If
End If
Next
If executed then
If err.number <> 0 then
'File was found, but delete was unsuccessful, log failure of delete.
executed = false
err.clear
Else
'Delete file procedure executed successfully. Lets move on.
executed = false
End If
Else
'No file was found within the conditions. log failure of search.
End if
'Move file and rename procedure...
Set FLD = objFSO.GetFolder(strfolder)
For Each fil in FLD.Files
strOldName = fil.Path
If InStr(strOldName, "-") > 0 Then
strFileParts = Split(strOldName, "-")
strNewName = strFileParts(0) & ".log"
objFSO.MoveFile strOldName, strNewName
executed = true
End If
Next
Set FLD = Nothing
Set FSO = Nothing
If executed then
If err.number <> 0 then
'File was found, but move was unsuccessful, log failure of move.
executed = false
err.clear
Else
'Move file procedure executed successfully. Lets move on.
executed = false
End If
Else
'No file was found within the conditions. log failure of search.
End if
For Each line in TFStrings
strNextLine = line
arrServiceList = Split(strNextLine , ",")
For i = 3 to Ubound(arrServiceList)
objshell.LogEvent 4, arrServiceList(i)
Next
Next

Excel Search in subfolders

Using the following code that I pulled from the web, I'm able to do a search in a single directory for excel files containing a string in a certain row. How would I allow this to be recursive in all the subfolders as well? I've found a few answers but I just don't understand how I would implement them in my code. I only started messing with VBScript yesterday and I'm pretty confused about how to make this work.
strComputer = "CAA-W74109188"
Set objExcel = CreateObject("Excel.Application", strComputer)
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set FileList = objWMIService.ExecQuery _
("ASSOCIATORS OF {Win32_Directory.Name='c:\TDRS'} Where " _
& "ResultClass = CIM_DataFile")
For Each objFile In FileList
If (objFile.Extension = "xlsm" or objFile.Extension = "xls") Then
Set objWorkbook = objExcel.Workbooks.Open(objFile.Name)
Set objWorksheet = objWorkbook.Worksheets(1)
If objExcel.Cells(3,10) = "Complete" or objExcel.Cells(3,9) = "Released" Then
Wscript.Echo objFile.FileName
End If
objExcel.DisplayAlerts = False
objworkbook.Saved = False
objWorkbook.Close False
End If
Next
objExcel.Quit
Here is an script that I used to delete files with, which I have modified for your needs. A recursive function is what you need to get the job done and I have always found them to be interesting and kind of hard to wrap my head around.
Dim Shell : Set Shell = WScript.CreateObject( "WScript.Shell" )
Dim oFSO : Set oFSO = CreateObject("Scripting.FileSystemObject")
Dim objExcel : Set objExcel = CreateObject("Excel.Application")
Dim Paths(0)
Paths(0) = "c:\temp"
For Each Path in Paths
FolderScan(Path)
Next
Sub FolderScan(Folder)
Set base = oFSO.GetFolder(Folder)
If base.SubFolders.Count Then
For Each folder in Base.SubFolders
FolderScan(folder.Path)
Next
End If
Set files = base.Files
If files.Count Then
For Each File in files
If LCase(oFSO.GetExtensionName(File.Path) = "xlsm") or _
LCase(oFSO.GetExtensionName(File.Path) = "xls") Then
Dim objWorkbook : Set objWorkbook = objExcel.Workbooks.Open(File.Path)
Dim objWorkSheet : Set objWorkSheet = objWorkbook.Worksheets(1)
If (objExcel.Cells(3,10) = "Complete" or _
objExcel.Cells(3,9) = "Released") Then
Wscript.echo File.Path
End if
objExcel.DisplayAlerts = False
objExcel.Quit
End If
Next
End If
End Sub
Here's a generic, recursive function that iterates all files and subfolders of a given folder object.
Dim FileSystem
Set FileSystem = CreateObject("Scripting.FileSystemObject")
DoFolder FileSystem.GetFolder("c:\somefolder")
Sub DoFolder(Folder)
Dim SubFolder
For Each SubFolder In Folder.SubFolders
DoFolder SubFolder
Next
Dim File
For Each File In Folder.Files
' Operate on each file
Next
End Sub

Do I need a wait time for setting a new folder vbs?

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

Resources