I need some help on below script I am doing a auto delete based on file extension and date modified.
I just started on vbscript so not really sure about how it worked.
I will want it to delete older file based on date and file extension when the first condition is true and if the condition is false it will end
Option Explicit
Dim objFSO : Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim objSTR, objTYP, objFILE`enter code here`
Dim Folder, SubFolder
Dim objNetwork, strRemoteshare, strUser, strPassword
Set objNetwork = WScript.CreateObject("WScript.Network")
strRemoteShare = "shared drive path"
strUser = "user"
strPassword = "password"
objNetwork.MapNetworkDrive "X:", strRemoteshare, True, strUser,
strPassword
objNetwork.RemoveNetworkDrive "X:", True , True
objTYP = "file extension"
For Each objFILE In objFSO.GetFolder("folder path").Files
If objFile.Type = objTYP And objFILE.DateLastModified <
DateAdd("d",-5,Now) = True Then
'in the statement here i want it delete the older file based on
'objFile.Type = objTYP And objFILE.DateLastModified > DateAdd("d",-10,Now)
ElseIf objFile.Type = objTYP And objFILE.DateLastModified <
DateAdd("d",-5,Now) = False Then
End If
Next
Based on the comments in the question you need to first fix the evaluation and then add the call to File object Delete() method.
For Each objFILE In objFSO.GetFolder("folder path").Files
If objFILE.Type = objTYP And objFILE.DateLastModified < DateAdd("d", -7, Now()) Then
'File older than 7 days will be removed.
Call objFILE.Delete(True) 'Pass true to force deletion.
End If
Next
Useful Links
How to do multiple conditions for single If statement
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 have written a VBScript to group the files based on the file type for a particular folder path (given as input). I'm trying to handle a scenario that when a folder path is empty, the script should ask us to mention the file path. However, I'm not able to handle it.
v_Path = InputBox("Enter the FileName Along With Path")
If IsEmpty(v_Path) Then
MsgBox("What's the File Path?")
Else
Set objFso = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(v_Path)
Set colFiles = objFolder.Files
For Each objFile in colFiles
v_FileName = v_Path&"\" & objFile.Name
v_FileExtensionName = v_Path & "\" & objFso.GetExtensionName(v_FileName)
If Not(objFso.FolderExists(v_FileExtensionName)) Then
objFso.CreateFolder(v_FileExtensionName)
objFso.MoveFile v_FileName, v_FileExtensionName & "\"
Else
objFso.MoveFile v_FileName, v_FileExtensionName & "\"
End If
Next
MsgBox("Files Grouped Based on File Type!!")
End If
Set objFso = Nothing
Set objFolder = Nothing
Set colFiles = Nothing
IsEmpty is looking at the string here and saying v_Path is initiliazed or not. If the variable was an object reference, or not declared, then isEmpty will return true. In this case, the message box returns an empty string or ""
Try this change,
If Isempty(v_Path) or v_Path = "" Then
or just
If v_Path = "" Then
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
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
I have a problem - instances of Excel and Word behave differently in the same procedure. Have a look at the code. The idea there is to have a procedure that handles resaving files in excel and word in various format combinations.
The problem is that I notice that word and excel behave differently - the appWord and appExcel have different type names. At some point appWord is changed from Application to Object, which then makes it impossible to close it. I don't understand the differences in the behaviour, since the code applied to them is identical.
Option Explicit
Dim fso
Dim appWord
Dim appExcel
Set fso = CreateObject("Scripting.FileSystemObject")
startWord
ResaveFiles appWord.Documents, "docx", 12, 0
appWord.quit
startExcel
ResaveFiles appExcel.Workbooks, "xlsx", 51, 56
appExcel.quit
MsgBox "All done."
Sub ResaveFiles(appType, srcExtName, srcExtNum, tmpExtNum)
Dim objFile
Dim objOpenFile
Dim strDirectory
For Each objFile in fso.GetFolder(".").Files
If lcase(fso.GetExtensionName(objFile)) = srcExtName Then
If typeName(appType) = "Documents" Then StartWord
If typeName(appType) = "Workbooks" Then StartExcel
Set objOpenFile = appType.Open(objFile.path)
strDirectory = fso.BuildPath(objOpenFile.path, fso.GetBaseName(objOpenFile.name) & "._temp")
objOpenFile.SaveAs strDirectory, tmpExtNum
objOpenFile.Close
msgBox typename(appType) & objFile
msgBox typename(appWord) 'First typename test
msgBox Typename(appExcel)
If typeName(appType) = "Documents" Then appWord.Quit
If typeName(appType) = "Workbooks" Then appExcel.Quit
set objOpenFile = appType.Open(strDirectory)
objOpenFile.SaveAs objFile.path, srcExtNum
objOpenFile.Close
fso.DeleteFile(strDirectory)
msgBox typename(appWord) 'Second typename test
msgBox Typename(appExcel)
End If
Next
End Sub
'Start Word
Sub StartWord
Set appWord = CreateObject("Word.Application")
appWord.visible = false
appWord.DisplayAlerts = false
End Sub
'Start Excel
Sub StartExcel
Set appExcel = CreateObject("Excel.Application")
appExcel.visible = false
appExcel.DisplayAlerts = false
End Sub
I have tested it in the following way (with two typename tests) - when there are word files available, first appWord is Application and appExcel is empty, then it changes to Object and appExcel stays Empty (in this case we get an error when the subprocedure ends at AppWord.Quit). When there are no word files, and the script is processing Excels, first appWord is Object and appExcel is Application, then appWord is still Object and appExcel is still Application - in this case there are no errors when the subprocedure ends, on the appExcel.Quit.
Maybe i'm wrong, just my opinion:
If typeName(appType) = "Documents" Then appWord.Quit
If typeName(appType) = "Workbooks" Then appExcel.Quit
set objOpenFile = appType.Open(strDirectory)
appType is a reference to what appWord.Documents or appExcel.Workbooks are referencing before entering your ResaveFiles Sub, where you instantiate a new copy of 'Excel.Application' or 'Word.Application', and in each of the cases, you instruct the application TO QUIT. The question is not why in the case of word you got an error. From my point of view YOU SHOULD got an error. The question is why, if instructed to quit, excel keeps open and maintaining references to handle your code.
EDIT - And not tried. Just adapted from OP code. Adapt as needed
Option Explicit
ResaveFiles "Word.Application", "docx", 12, 0
ResaveFiles "Excel.Application", "xlsx", 51, 56
MsgBox "All done."
Sub ResaveFiles(progID, srcExtName, srcExtNum, tmpExtNum )
Dim app, doc
Dim fso, objFile, objOpenFile, strDirectory
Set fso = CreateObject("Scripting.FileSystemObject")
For Each objFile in fso.GetFolder( "." ).Files
If LCase(fso.GetExtensionName( objFile.Name )) = srcExtName Then
' Get references
Set app = GetNewAppInstance( progID )
Set doc = GetDocumentHandler( app )
' Save temp
Set objOpenFile = doc.Open( objFile.Path )
strDirectory = fso.BuildPath( objOpenFile.path, fso.GetBaseName(objOpenFile.name) & "._temp" )
objOpenFile.SaveAs strDirectory, tmpExtNum
objOpenFile.Close
' Release objects
Set objOpenFile = nothing
Set doc = nothing
app.Quit
Set app = nothing
' Get references again
Set app = GetNewAppInstance( progID )
Set doc = GetDocumentHandler( app )
' Resave file
Set objOpenFile = doc.Open( strDirectory )
objOpenFile.SaveAs objFile.path, srcExtNum
objOpenFile.Close
' Release objects
Set objOpenFile = nothing
Set doc = nothing
app.Quit
Set app = nothing
' Clean
fso.DeleteFile(strDirectory)
End If
Next
End Sub
Function GetNewAppInstance( ByVal progID )
Set GetNewAppInstance = CreateObject( progID )
With GetNewAppInstance
.Visible = False
.DisplayAlerts = False
End With
End Function
Function GetDocumentHandler( app )
Dim name
name = app.Name
If InStr(name,"Excel") > 0 Then
Set GetDocumentHandler = app.Workbooks
ElseIf InStr(name,"Word") > 0 Then
Set GetDocumentHandler = app.Documents
Else
Set GetDocumentHandler = app
End If
End Function