Make log for deleted files using VBScript - vbscript

The below is my code to delete DAT files.
OPTION EXPLICIT
DIM strExtensionsToDelete,strFolder
DIM objFSO, MaxAge, IncludeSubFolders
' ************************************************************
' Setup
' ************************************************************
' Folder to delete files
strFolder = "E:\test"
' Delete files from sub-folders?
includeSubfolders = true
' A comma separated list of file extensions
' Files with extensions provided in the list below will be deleted
strExtensionsToDelete = "dat"
' Max File Age (in Days). Files older than this will be deleted.
maxAge = 0
' ************************************************************
set objFSO = createobject("Scripting.FileSystemObject")
DeleteFiles strFolder,strExtensionsToDelete, maxAge, includeSubFolders
wscript.echo "Finished"
sub DeleteFiles(byval strDirectory,byval strExtensionsToDelete,byval maxAge,includeSubFolders)
DIM objFolder, objSubFolder, objFile
DIM strExt
set objFolder = objFSO.GetFolder(strDirectory)
for each objFile in objFolder.Files
for each strExt in SPLIT(UCASE(strExtensionsToDelete),",")
if RIGHT(UCASE(objFile.Path),LEN(strExt)+1) = "." & strExt then
IF objFile.DateLastModified < (Now - MaxAge) THEN
wscript.echo "Deleting:" & objFile.Path & " | " & objFile.DateLastModified
objFile.Delete
exit for
END IF
end if
next
next
if includeSubFolders = true then ' Recursive delete
for each objSubFolder in objFolder.SubFolders
DeleteFiles objSubFolder.Path,strExtensionsToDelete,maxAge,includeSubFolders
next
end if
end sub
Now i want to create a log files to store the deleted files information (such as name of the file, when the script is run and user who run this script). Can any one help me with this ?
Thanks in Advance..

If I should go with your style pattern.
' outside your DeleteFiles()
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set LogFile = objFSO.CreateTextFile(objFSO.GetTempName)
LogFile.WriteLine "DateTime: " & Now
LogFile.WriteLine "UserName: " & CreateObject("WScript.NetWork").UserName
DeleteFiles ...
' outside your DeleteFiles()
LogFile.Close
WScript.Echo "Finished"
Sub DeleteFiles(...
' inside For..Next in DeleteFiles()
LogFile.WriteLine objFile.Path
End Sub

Related

While executing delete script getting error wrong number of arguments or error invalid property assignment:' objFolder.Files.Item'

I have written VBScript to delete the files from the folder which are 30days older. even I need to add entry in log file. But here I need to list the name of the files which got deleted in log file. while doing that I am getting error.
Const strPath = "D:\TextReport\"
Dim objFSO
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set LogFile = objFSO.CreateTextFile("D:\Text\ASD.txt", true)
LogFile.WriteLine "DateTime: " & Now
LogFile.WriteLine "UserName: " & CreateObject("WScript.NetWork").UserName
Call Search (strPath)
' Comment out below line if you'd like to use this script in windows schedule task
WScript.Echo"Done."
Sub Search(str)
Dim objFolder, objSubFolder, objFile
Set objFolder = objFSO.GetFolder(str)
For Each objFile In objFolder.Files
' Use DateLastModified for modified date of a file
If objFile.DateLastModified < (Now() - 30) Then
objFile.Delete(True)
End If
LogFile.WriteLine (objFolder.Files.Item.Name)
Next
For Each objSubFolder In objFolder.SubFolders
Search(objSubFolder.Path)
' Files have been deleted, now see if the folder is empty.
If (objSubFolder.Files.Count = 0) Then
objSubFolder.Delete True
End If
Next
End Sub
LogFile.Close
WScript.Echo "Finished"
You are trying to get the name of a file that you deleted. Log the name inside the date check.
If objFile.DateLastModified < (Now() - 30) Then
LogFile.WriteLine objFile.Name
objFile.Delete(True)
End If

How to delete x days older file from a Folder with specified extension

Here is the VBS code I have, which is deleting all the .exe or any other given extension files from a folder of a given day of old files.
But it's asking for confirmation before deleting each file, which I have to then confirm manually by clicking OK. I need to disable that confirmation, so that the script deletes all the specified extension files once I clicked, and no confirmations are needed.
Option Explicit
Dim strExtensionsToDelete,strFolder
Dim objFSO, MaxAge, IncludeSubFolders
' Folder to delete files
strFolder = "C:\Users\Public\Downloads"
' Delete files from sub-folders?
includeSubfolders = True
' A comma separated list of file extensions
' Files with extensions provided in the list below will be deleted
strExtensionsToDelete = "exe,.exe"
' Max File Age (in Days). Files older than this will be deleted.
maxAge = 5
Set objFSO = CreateObject("Scripting.FileSystemObject")
DeleteFiles strFolder, strExtensionsToDelete, maxAge, includeSubFolders
Sub DeleteFiles(ByVal strDirectory, ByVal strExtensionsToDelete, ByVal maxAge, includeSubFolders)
Dim objFolder, objSubFolder, objFile
Dim strExt
Set objFolder = objFSO.GetFolder(strDirectory)
For Each objFile In objFolder.Files
For Each strExt In Split(UCase(strExtensionsToDelete), ",")
If Right(UCase(objFile.Path), Len(strExt)+1) = "." & strExt Then
If objFile.DateLastModified < (Now - MaxAge) Then
WScript.Echo "Deleting:" & objFile.Path & " | " & objFile.DateLastModified
objFile.Delete
Exit For
End If
End If
Next
Next
If includeSubFolders = True Then ' Recursive delete
For Each objSubFolder In objFolder.SubFolders
DeleteFiles objSubFolder.Path, strExtensionsToDelete, maxAge, includeSubFolders
Next
End If
End Sub

Memory leak with a recursive sub using VBScript

I'm creating a script that will allow a user to search within a specified directory with a search term. The script will create a CSV file and then write the base file name, the file size, the last modified date, and the absolute path of files that contain the search term within the file name. However, I'm running into an issue searching subfolders within the folder. The issue is that I'm running out of memory within the subroutine.
Here is the script I've written thus far.
Dim fileCount, searchPath, searchTerm, CheckFile, wholePath
Dim objFSO, objFolder, objFile, objWriteFile
Dim savePath
objCheckFile = "C:\Users\USERFILE\Desktop\Audit.csv"
Const ForWriting = 2
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Asks for directory to search in
searchPath = InputBox("Please enter the path of the folder you would like to search", "Where am I searching?")
Set objFolder = objFSO.GetFolder(searchPath)
'Asks for the search term to use
searchTerm = InputBox("Please enter the term you would like to search for", "What am I searching?")
If objFSO.FileExists(objCheckFile) Then
WScript.Echo "Please delete the file named Audit.csv before trying again"
Else
Set objWriteFile = objFSO.CreateTextFile("Audit.csv", ForWriting, True)
End If
Set colFiles = objFolder.Files
Set colFolders = objFolder.SubFolders
'Searches for files within the folder and writes to a CSV file
For Each objFile In colFiles
If InStr(LCase(objFSO.GetFileName(objFile)), LCase(searchTerm)) > 0 Then
objWriteFile.Write objFSO.getFileName(objFile) & ", "
objWriteFile.Write objFile.size & ", "
objWriteFile.Write objFile.DateLastModified & ", "
objWriteFile.Write objFSO.getAbsolutePathName(objFolder) & objFSO.getFileName(objFile)
objWriteFile.Writeline
End If
Next
ShowSubFolder objFolder
Sub ShowSubFolder(Folder)
If InStr(LCase(objFSO.GetFileName(objFile)), LCase(searchTerm)) > 0 Then
objWriteFile.Write objFSO.getFileName(objFile) & ", "
objWriteFile.Write objFile.size & ", "
objWriteFile.Write objFile.DateLastModified & ", "
objWriteFile.Write objFSO.getAbsolutePathName(objFolder) & objFSO.getFileName(objFile)
objWriteFile.Writeline
End If
For Each objSubFolder In colFolders
ShowSubFolder objSubFolder
Next
End Sub
Your recursion never terminates because of this:
Set colFiles = objFolder.Files
Set colFolders = objFolder.SubFolders
'...
ShowSubFolder objFolder
Sub ShowSubFolder(Folder)
'...
For Each objSubFolder In colFolders
ShowSubFolder objSubFolder
Next
End Sub
This is similar to a fork bomb. For each subfolder of objFolder you recurse again into each subfolder of objFolder. And again. And again. And ...
Change your code to this and it should do what you want:
Set colFiles = objFolder.Files
'...
ShowSubFolder objFolder
Sub ShowSubFolder(Folder)
'...
For Each objSubFolder In Folder.SubFolders
ShowSubFolder objSubFolder
Next
End Sub
You may also want to adjust the conditional inside the recursive procedure, because it uses objFile and objFolder that are defined outside the procedure.

VBScript: Getting error by batch renaming files within a folder

In this script I try to rename all the files within a folder. The new names I will gather from each textfiles in itself using Instr(1, strText, "(Amtlicher Gemeindeschlüssel = " ...). So all jsp-files shall be proceed. But I get an object-error almost at the end: 800A01A8 - Object Required. Can anyone helpme to replace the object strVerz.files so the the code works.
Thank U in advance.
Michael
Dim objFso, strFolder
' Begin Main
Set objFso = CreateObject("Scripting.FileSystemObject")
strFolder = objFso.GetParentFolderName(WScript.ScriptFullName)
If objFso.FolderExists(strFolder) Then
Call GetJspFiles(objFso.GetFolder(strFolder))
End If
Set objFso = Nothing
' End Main
Sub GetJspFiles(ByRef objFolder)
Dim objFile, objSubFolder
For Each objFile In objFolder.Files
If LCase(objFso.GetExtensionName(objFile.Name)) = "jsp" Then
Call JSPRename(objFile.Path, objFolder.Path)
End If
Next
For Each objSubFolder In objFolder.SubFolders
Call GetJspFiles(objSubFolder)
Next
' objFile.Close
End Sub
Sub JSPRename(ByRef strPath, ByRef strFolder)
Dim arrText, strText, strTextLine, Position , objJspFile, newFilename, strVerz
Set objJspFile = objFso.OpenTextFile(strPath)
arrText = Split(objJspFile.ReadAll, vbCrLf) ' split to lines
For Each strTextLine In arrText
If strTextLine <> "" Then
strText = Trim(strTextLine)
If Instr(1,strText,"(Amtlicher Gemeindeschlüssel",1) Then
Position=Instr(1, strText, "(Amtlicher Gemeindeschlüssel =",1)
newFilename=mid(strText,Position+31, 8)
else
end if
end if
Next
strVerz=objFSO.GetParentFoldername(WScript.ScriptFullName)
strNewName = strVerz & "\" & newFilename & ".jsp"
' Wscript.echo strNewName & vbcrlf & strVerz.files '!! only for Showing the results
objFSO.MoveFile strVerz.files, strNewName <- Here I get the error
objJspFile.Close
End Sub
It seems like the purpose of JSPRename is to rename the file given by strPath. In that case, the call to MoveFile should look like:
objFSO.MoveFile strPath, strNewName

VBS rename file to the same as a folder name

Is it possible to rename a file in a folder to its folder name using vbs? I have the following script which I am just using MsgBox at this time for debugging before I implement the renaming. for some reason tho ObjFolder doesnt change.
Option Explicit
Dim strFolderToSearch, objFSO, objRootFolder, objFolder, colSubfolders, strOutput, objStartFolder, colFiles, objFile
strFolderToSearch = "D:\Shared\Films"
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objRootFolder = objFSO.GetFolder(strFolderToSearch)
Set colSubfolders = objRootFolder.SubFolders
For Each objFolder in colSubfolders
objStartFolder = objFolder
Set objFolder = objFSO.GetFolder(objStartFolder)
Set colFiles = objFolder.Files
For Each objFile in colSubfolders
MsgBox objFile.name & "," & objFolder.name
Next
Next
I admit that I can't follow the tangle of your folders, subfolders, and files. But if you want to rename files in a folder, use this stratege:
Dim sDName : sDName = "FancyRename"
Dim sDName2 : sDName2 = "," & sDName
Dim oFile, sNewName
For Each oFile In goFS.GetFolder(goFS.BuildPath("..\testdata", sDName)).Files
If 0 = Instr(oFile.Name, sDName2) Then
sNewName = Replace(oFile.Name, ".", sDName2 & ".")
Else
sNewName = Replace(oFile.Name, sDName2, "")
End If
WScript.Echo oFile.Name, "=>", sNewName
oFile.Name = sNewName
Next
output of running this three times:
that.txt => that,FancyRename.txt
this.txt => this,FancyRename.txt
that,FancyRename.txt => that.txt
this,FancyRename.txt => this.txt
that.txt => that,FancyRename.txt
this.txt => this,FancyRename.txt
UPDATE
How about: Given a folder D and a file name F (e.g. someavi.avi), rename all (existing) Fs in D and its sub folders to "subfoldername.avi", unless such a file already exists:
recursiveRename goFS.GetFolder("..\testdata\FancyRename"), "someavi", "avi"
Sub recursiveRename(oDir, sFiNa, sExt)
WScript.Echo "Looking into", oDir.Path
Dim sOFiNa : sOFiNa = sFiNa & "." & sExt
Dim sOFSpec : sOFSpec = goFS.BuildPath(oDir.Path, sOFiNa)
Dim sNFSpec
If goFS.FileExists(sOFSpec) Then
WScript.Echo "found ", sOFSpec
sNFSpec = goFS.BuildPath(oDir.Path, oDir.Name & "." & sExt)
If goFS.FileExists(sNFSpec) Then
WScript.Echo "found ", sNFSpec, "- can't rename"
Else
WScript.Echo "found no", sNFSpec, "- will rename"
goFS.MoveFile sOFSpec, sNFSpec
End If
Else
WScript.Echo "found no", sOFSpec
End If
Dim oSubF
For Each oSubF In oDir.SubFolders
recursiveRename oSubF, sFiNa, sExt
Next
End Sub
sample output:
Looking into M:\lib\kurs0705\testdata\FancyRename
found no M:\lib\kurs0705\testdata\FancyRename\someavi.avi
Looking into M:\lib\kurs0705\testdata\FancyRename\subfa
found no M:\lib\kurs0705\testdata\FancyRename\subfa\someavi.avi
Looking into M:\lib\kurs0705\testdata\FancyRename\subfc
found M:\lib\kurs0705\testdata\FancyRename\subfc\someavi.avi
found no M:\lib\kurs0705\testdata\FancyRename\subfc\subfc.avi - will rename
Looking into M:\lib\kurs0705\testdata\FancyRename\subfb
found M:\lib\kurs0705\testdata\FancyRename\subfb\someavi.avi
found M:\lib\kurs0705\testdata\FancyRename\subfb\subfb.avi - can't rename
UPDATE II
Changed specs: rename .avi to folder name, if there is exactly one .avi
recursiveRename03 goFS.GetFolder("..\testdata\FancyRename")
Sub recursiveRename03(oDir)
WScript.Echo "Looking into", oDir.Path
Dim sNFSpec : sNFSpec = goFS.BuildPath(oDir.Path, oDir.Name & ".avi")
If goFS.FileExists(sNFSpec) Then
WScript.Echo "found ", sNFSpec, "- can't rename"
Else
Dim oOFile : Set oOFile = Nothing
Dim oFile
For Each oFile In oDir.Files
If "avi" = goFS.GetExtensionName(oFile.Name) Then
If oOFile Is Nothing Then
Set oOFile = oFile
Else
WScript.Echo "Found second avi", oFile.Name
Set oOFile = Nothing
Exit For
End If
End If
Next
If oOFile Is Nothing Then
WScript.Echo "not exactly one avi found"
Else
WScript.Echo "found ", oOFile.Name, "- will rename"
oOFile.Name = oDir.Name & ".avi"
End If
End If
Dim oSubF
For Each oSubF In oDir.SubFolders
recursiveRename03 oSubF
Next
End Sub
UPDATE III
If you use a global FSO or pass an FSO to the Subs/Functions needing
it, you avoid its repetitive re-creation.
If you pass a folder/file object instead of a string to the
Subs/Functions dealing with such objects, you can access their
properties/methods immediately/for free (no need to reclaim/get back
info by string operations).
If you rename a file, you must check whether there is a file having
the new name (it's not sufficient to check whether the file you work
with doesn't have the new name).
Idealistically, your script should have the following features:
Recursion - For traversing folders that are 1-n deep from D:\Shared\Films
Rename file function - For renaming match files according to your rule.
I wrote the following script that features the following routines:
RenameAllVideos(strFolder) - this will recursively search subfolders
RenameVideo(strFileName) - will rename a match video file using your rule
Here's my script:
Option Explicit
Call RenameAllVideos("D:\Shared\Films")
Sub RenameAllVideos(strFolder)
Dim fso, file, folder
Set fso = CreateObject("Scripting.FileSystemObject")
' Check for AVIs to rename.
For Each file in fso.GetFolder(strFolder).Files
If Right(file.Name, 4) = ".avi" Then
Call RenameVideo(strFolder & "\" & file.Name)
End If
Next
' Check for SubFolders to recurse into.
For Each folder in fso.GetFolder(strFolder).SubFolders
Call RenameAllVideos(strFolder & "\" & folder.Name)
Next
End Sub
Sub RenameVideo(strFileName)
Dim fso, strExt, strFolder, strNewFileName
Set fso = CreateObject("Scripting.FileSystemobject")
' Note the extension (should be avi)
strExt = fso.GetExtensionName(strFileName)
' Derive the full path to the folder.
strFolder = fso.GetParentFolderName(strFileName)
' Derive the new filename.
strNewFileName = strFolder & "\" & fso.GetBaseName(strFolder) & "." & strExt
' Do the rename.
If strFileName <> strNewFileName Then
WScript.Echo "Renaming " & strFileName & " to " & strNewFileName
fso.MoveFile strFileName, strNewFileName
End If
End Sub

Resources