Solved

VBScript modification: Email formatting for log deletion script

Posted on 2008-10-02
5
452 Views
Last Modified: 2012-05-05
Hello,

I have a .vbs script that is designed to delete files and logs that are older than a defined number of days.
The date is defined as the "cutoff" variable. The script is also designed to send an email after it deletes the logs and files.

In my current example only, the files contained in 2 directories are deleted (cleanup).
The production version will possibly delete all logs and files in about 10 directories.

What I would like to do is have the script send one email containing the name of the directory and a list of the files and logs that were deleted, for example

Accountsystem
1. Log 1
2. Log 2
3. Log 3

etc.

AsyncQueue
1. Log 1
2. Log 2
3. Log 3

etc.

Please let me know if there is a way to do this.

Thanks.
'<<<<<<<<<<<<DEFINE VARIABLES HERE-BEGIN>>>>>>>>>>>>>>>>>>
DIM cutoff, curyear, scriptStatus, mailto, mailfrom, maillog
'DEFINE CUTOFF DATE (LOG FILES OF DATES OLDER THAN THIS DATE SHOULD BE DELETED)
'SPECIFY CUTOFF DATE IN CENTER PARAMETER
	cutoff = dateadd("d", -10, date)'wscript.echo "Cut off=" & cutoff
'GET CURRENT YEAR FOR REGULAR EXPRESSION TO PERFORM LOG DELETION 
	curyear = year(now) 'wscript.echo "Current Year=" & curyear
'PARAMETER TO ENABLE LOGS TO BE DELETED
'SET TO 'ON' TO ENABLE 'OFF' TO DISABLE
	scriptStatus = "ON"
'EMAIL TO ADDRESS (Add multiple by seperating with commas)
	mailto = "me@me.com"
'EMAIL FROM ADDRESS (Add multiple by seperating with commas)
	mailfrom = "me@me.com"
'<<<<<<<<<<<<DEFINE VARIABLES HERE-END>>>>>>>>>>>>>>>>>>
 
'++++++++++++++++++++++++EMAIL CONFIGURATION BEGIN++++++++++++++++++++++++++++++++++
set maillog = createobject("CDO.Message") 
'This section provides the configuration information for the remote SMTP server.
maillog.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2 'Send the message using the network (SMTP over the network).
maillog.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserver") ="mx01exchange.me.com"
maillog.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25 
maillog.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = False 'Use SSL for the connection (True or False)
maillog.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 30
maillog.Configuration.Fields.Update
'End remote SMTP server configuration section==
maillog.from = mailfrom
maillog.to = mailto
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
if scriptStatus = "ON" then
'DELETE ALL RDTemp FILES
arrayHeaders = array("AccountSystem", "AsyncQueue")
arrayTotal = UBound(arrayHeaders)
'wscript.echo arrayHeaders(0)
 
	if arrayHeaders(0) = "AccountSystem" then
	'DELETE ALL ACCOUNTSYSTEM LOG FILES
	cleanup  "D:\MyApp\LOG\Accountsystem", "^"&curyear& ".*?\.log$", cutoff
	if arrayHeaders(1) = "AsyncQueue" then
	'DELETE ALL ASYNCQUEUE LOG FILES
	cleanup  "D:\MyApp\LOG\AsyncQueue", "^"&curyear& ".*?\.xml$", cutoff
	end if
	end if
''''''''''''''''''''''''''''''''''''''''''''''''
 
'-------------------------------------------------------------------------------------------------------------
 
 
'--------------------------------------------------------------------------------------------------------------
 
 
'******************FUNCTIONS USED TO DELETE FILES************************************
Sub cleanup(folderName, pattern, cutoff)
Set fso = createobject("scripting.filesystemobject")
Set folder = fso.getfolder(folderName)
Set files = folder.files
Set re = new regexp
	re.Pattern = pattern
	countFiles = 0
	countSize = 0
	file = j
For each file in files
	  
 If re.Test(file.name) Then
 If file.datelastmodified < cutoff Then
 'wscript.echo "Deleting " & file.name &" last modified: " & file.datelastmodified
 'wscript.echo countFiles
 'wscript.echo "Clean up=" & cleanup
 
 countFiles = countFiles + 1
 countSize = countSize + file.Size
 strbody = strbody &vbCrLf & countFiles & ":" &  "Deleted" & file.name &" last modified: " & file.datelastmodified & vbCrLf
 maillog.textbody = strbody
 
countFilesFINAL = countFiles
 On Error Resume Next
 file.delete
 End If
 End If
 	
Next
 
'wscript.echo "Deleted " & countFiles & " files from " & folderName & " [" & niceSize(countSize) & "]"
 
maillog.subject = "ATTENTION: "&countFilesFINAL& " logs and files older than " & cutoff & " have been deleted"
 Set re = Nothing
 Set files = Nothing
 Set folder = Nothing
 Set fso = Nothing
'maillog.subject = "ATTENTION: "&countFilesFINAL& " logs and files older than " & cutoff & " have been deleted"
 End Sub
 
 
Function niceSize(size)
 units = "B"
 If size > 1024 Then
 size = Round(size / 1024, 1)
 units = "kB"
 End If
 If size > 1024 Then
 size = Round(size / 1024, 2)
 units = "MB"
 End If
 If size > 1024 Then
 size = Round(size / 1024, 3)
 units = "GB"
 End If
 niceSize = "" & size & units
End Function
'*************************************************************************************
elseif scriptStatus = "OFF" then
maillog.subject = "ATTENTION: RE: The RedDot logs and files deletion script did not run properly"
	cleanupOFF = "The script is turned off"
	'wscript.echo cleanupOFF
	strbody = cleanupOFF
	maillog.textbody = strbody
end if
 
maillog.send
Set maillog = nothing

Open in new window

0
Comment
Question by:baxleyb
  • 3
  • 2
5 Comments
 
LVL 14

Assisted Solution

by:rejoinder
rejoinder earned 350 total points
ID: 22631776
Try this.  The output should look like what you requested plus if a file cannot be deleted you will see this in the email.
On the line;
arrayHeaders = array("AccountSystem", "AsyncQueue")
Enter as many folder titles you want.
In this section;

        select case strHeader
            Case "AccountSystem"
                'DELETE ALL ACCOUNTSYSTEM LOG FILES
                cleanup  "D:\MyApp\LOG\Accountsystem", "^"&curyear& ".*?\.log$", cutoff
            Case "AsyncQueue"
                'DELETE ALL ASYNCQUEUE LOG FILES
                cleanup  "D:\MyApp\LOG\AsyncQueue", "^"&curyear& ".*?\.xml$", cutoff
        End Select
Add a new Case statement for each additional item in your array.

For example;
arrayHeaders = array("AccountSystem", "AsyncQueue","Temp")

        select case strHeader
            Case "AccountSystem"
                'DELETE ALL ACCOUNTSYSTEM LOG FILES
                cleanup  "D:\MyApp\LOG\Accountsystem", "^"&curyear& ".*?\.log$", cutoff
            Case "AsyncQueue"
                'DELETE ALL ASYNCQUEUE LOG FILES
                cleanup  "D:\MyApp\LOG\AsyncQueue", "^"&curyear& ".*?\.xml$", cutoff
            Case "Temp"
                'DELETE ALL TEMP LOG FILES
                cleanup  "D:\MyApp\LOG\Temp", "^"&curyear& ".*?\.tmp$", cutoff
        End Select

'<<<<<<<<<<<<DEFINE VARIABLES HERE-BEGIN>>>>>>>>>>>>>>>>>>
DIM cutoff, curyear, scriptStatus, mailto, mailfrom, maillog, countFilesFINAL, strbody
'DEFINE CUTOFF DATE (LOG FILES OF DATES OLDER THAN THIS DATE SHOULD BE DELETED)
'SPECIFY CUTOFF DATE IN CENTER PARAMETER
	cutoff = dateadd("d", -10, date)'wscript.echo "Cut off=" & cutoff
'GET CURRENT YEAR FOR REGULAR EXPRESSION TO PERFORM LOG DELETION 
	curyear = year(now) 'wscript.echo "Current Year=" & curyear
'PARAMETER TO ENABLE LOGS TO BE DELETED
'SET TO 'ON' TO ENABLE 'OFF' TO DISABLE
	scriptStatus = "ON"
'EMAIL TO ADDRESS (Add multiple by seperating with commas)
	mailto = "me@me.com"
'EMAIL FROM ADDRESS (Add multiple by seperating with commas)
	mailfrom = "me@me.com"
'<<<<<<<<<<<<DEFINE VARIABLES HERE-END>>>>>>>>>>>>>>>>>>
 
'++++++++++++++++++++++++EMAIL CONFIGURATION BEGIN++++++++++++++++++++++++++++++++++
set maillog = createobject("CDO.Message") 
'This section provides the configuration information for the remote SMTP server.
maillog.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2 'Send the message using the network (SMTP over the network).
maillog.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserver") ="mx01exchange.me.com"
maillog.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25 
maillog.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = False 'Use SSL for the connection (True or False)
maillog.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 30
maillog.Configuration.Fields.Update
'End remote SMTP server configuration section==
maillog.from = mailfrom
maillog.to = mailto
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
if scriptStatus = "ON" then
    'DELETE ALL RDTemp FILES
    arrayHeaders = array("AccountSystem", "AsyncQueue")
    arrayTotal = UBound(arrayHeaders)
    for each strHeader in arrayHeaders
        strBody = strBody & vbCRLF & strHeader & vbCRLF
        select case strHeader
            Case "AccountSystem" 'DELETE ALL ACCOUNTSYSTEM LOG FILES
                cleanup  "D:\MyApp\LOG\Accountsystem", "^"&curyear& ".*?\.log$", cutoff
            Case "AsyncQueue"    'DELETE ALL ASYNCQUEUE LOG FILES
                cleanup  "D:\MyApp\LOG\AsyncQueue", "^"&curyear& ".*?\.xml$", cutoff
        End Select
    Next
    maillog.subject = "ATTENTION: " & countFilesFINAL & " logs and files older than " & cutoff & " have been deleted"
elseif scriptStatus = "OFF" then
    maillog.subject = "ATTENTION: RE: The RedDot logs and files deletion script did not run properly"
    strbody = "The script is turned off"
end if
 
maillog.textbody = strbody
maillog.send
Set maillog = nothing
 
'******************FUNCTIONS USED TO DELETE FILES************************************
Sub cleanup(folderName, pattern, cutoff)
    On Error Resume Next
    Set fso = createobject("scripting.filesystemobject")
    Set folder = fso.getfolder(folderName)
    Set files = folder.files
    Set re = new regexp
    re.Pattern = pattern
    countFiles = 0
    countSize = 0
    file = j
    For each file in files  
        If re.Test(file.name) Then
            If file.datelastmodified < cutoff Then
                file.delete
                countFiles = countFiles + 1
                if err.number > 0 then
                    strbody = strbody & countFiles & ". " & file.name & " <= ERROR... could not delete file!" & vbCRLF
                    err.clear
                else
                    countFilesFINAL = countFilesFINAL + 1
                    strbody = strbody & countFiles & ". " & file.name & vbCRLF
                end if
            End If
        End If 	
    Next
    Set re = Nothing
    Set files = Nothing
    Set folder = Nothing
    Set fso = Nothing
End Sub

Open in new window

0
 

Author Comment

by:baxleyb
ID: 22663253
Hello rejoinder,

Thanks for your help thus far, I made a a few revisions and so far the script is working well. The only issue I am having is when a file is found in the directory that does not meet the criteria of being deleted then it is listed multiple times in the email like this:

"Sorry, there are no files to delete that are older than 10 days in the AsyncQueue directory

Sorry, there are no files to delete that are older than 10 days in the AsyncQueue directory"

1. I would like to list this message just once instead of multiple times.

2. If possible I also would like to get a total of all files that were deleted.

Thanks in advance for your assistance.

Regards
'<<<<<<<<<<<<DEFINE VARIABLES HERE-BEGIN>>>>>>>>>>>>>>>>>>
DIM cutoff, curyear, scriptStatus, mailto, mailfrom, maillog
'DEFINE CUTOFF DATE (LOG FILES OF DATES OLDER THAN THIS DATE SHOULD BE DELETED)
'SPECIFY CUTOFF DATE IN CENTER PARAMETER
	cutoff = dateadd("d", -10, date)'wscript.echo "Cut off=" & cutoff
'SPECIFY ERROR MESSAGE IF THERE ARE NO FILES TO PROCESS
	sorry = "Sorry, there are no files to delete that are older than 10 days in the "
'GET CURRENT YEAR FOR REGULAR EXPRESSION TO PERFORM LOG DELETION 
	curyear = year(now) 'wscript.echo "Current Year=" & curyear
'PARAMETER TO ENABLE LOGS TO BE DELETED
'SET TO 'ON' TO ENABLE 'OFF' TO DISABLE
	scriptStatus = "ON"
'EMAIL TO ADDRESS (Add multiple by seperating with commas)
	mailto = "me@me.com"
'EMAIL FROM ADDRESS (Add multiple by seperating with commas)
	mailfrom = "me@me.com"
'<<<<<<<<<<<<DEFINE VARIABLES HERE-END>>>>>>>>>>>>>>>>>>
 
'++++++++++++++++++++++++EMAIL CONFIGURATION BEGIN++++++++++++++++++++++++++++++++++
set maillog = createobject("CDO.Message") 
'This section provides the configuration information for the remote SMTP server.
maillog.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2 'Send the message using the network (SMTP over the network).
maillog.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserver") ="mx01exchange.me.com"
maillog.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25 
maillog.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = False 'Use SSL for the connection (True or False)
maillog.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 30
maillog.Configuration.Fields.Update
'End remote SMTP server configuration section==
maillog.from = mailfrom
maillog.to = mailto
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
if scriptStatus = "ON" then
'DELETE ALL LOG AND TEMP FILES CONFIGURATION
 
'ADD TEMP FILE DIRECTORIES TO THE ARRAY TO DISPLAY THEM IN THE EMAIL
arrayHeaders = array("AccountSystem", "AsyncQueue", "Common", "Login", "Publishing", "Shared")
 
'ADD A CASE STATEMENT FOR EACH DIRECTORY OF FILES THAT SHOULD BE DELETED
for each strHeader in arrayHeaders
	strbody = strbody & vbCRLF & strHeader & vbCRLF
	select case strHeader
	Case "AccountSystem" 'DELETE ALL ACCOUNTSYSTEM LOG FILES
	cleanup  "D:\MyApp\LOG\Accountsystem", "^"&curyear& ".*?\.log$", cutoff
	
	Case "AsyncQueue" 'DELETE ALL ASYNCQUEUE LOG FILES
	cleanup  "D:\MyApp\LOG\AsyncQueue", "^"&curyear& ".*?\.xml$", cutoff
	
	Case "Common" 'DELETE ALL COMMON LOG FILES
	cleanup  "D:\MyApp\LOG\Common", "^"&curyear& ".*?\.log$", cutoff
		
	Case "Login" 'DELETE ALL LOGIN LOG FILES
	cleanup  "D:\MyApp\LOG\Login", "^"&curyear& ".*?\.log$", cutoff
	
	Case "Publishing" 'DELETE ALL PUBLISHING LOG FILES
	cleanup  "D:\MyApp\LOG\Publishing", "^"&curyear& ".*?\.xml$", cutoff
	cleanup  "D:\MyApp\LOG\Publishing", "^"&curyear& ".*?\.conf$", cutoff
	
	Case "Shared" 'DELETE ALL SHARED LOG FILES
	cleanup  "D:\MyApp\LOG\Shared", "^"&curyear& ".*?\.log$", cutoff
	
	End Select
Next
'--------------------------------------------------------------------------------------------------------------
'******************FUNCTIONS USED TO DELETE FILES************************************
Sub cleanup(folderName, pattern, cutoff)
Set fso = createobject("scripting.filesystemobject")
Set folder = fso.getfolder(folderName)
Set files = folder.files
Set re = new regexp
	re.Pattern = pattern
	countFiles = 0
	countSize = 0
For each file in files
	
'CHECK THE REGULAR EXPRESSION
If re.Test(file.name) Then
 	'IF THE DATELASTMODIFIED IS LESS THAN THE CUTOFF DATE THEN DELETE THE FILE
	If file.datelastmodified < cutoff Then
	'wscript.echo "Deleting " & file.name &" last modified: " & file.datelastmodified
	countFiles = countFiles + 1
 		countSize = countSize + file.Size
		strbody = strbody &vbCrLf & countFiles & ":" &  "Deleted-> " & file.name &" last modified: " & file.datelastmodified & vbCrLf
		maillog.textbody = strbody
	On Error Resume Next
	file.delete
	'IF THERE ARE NO MORE FILES TO PROCESS THEN SEND AN EMAIL MESSAGE
	else
		if countFiles = 0 then
		'wscript.echo "Nothing to delete"
		strbody = strbody & vbCRLF & sorry & strHeader & " directory" & vbCRLF
		maillog.textbody = strbody
		end if
	End If
	
	
 End If
 		
Next
 
'wscript.echo "Deleted " & countFiles & " files from " & folderName & " [" & niceSize(countSize) & "]"
maillog.subject = "ATTENTION: Logs and files older than " & cutoff & " have been deleted!"
 Set re = Nothing
 Set files = Nothing
 Set folder = Nothing
 Set fso = Nothing
 
 End Sub
 
 
Function niceSize(size)
 units = "B"
 If size > 1024 Then
 size = Round(size / 1024, 1)
 units = "kB"
 End If
 If size > 1024 Then
 size = Round(size / 1024, 2)
 units = "MB"
 End If
 If size > 1024 Then
 size = Round(size / 1024, 3)
 units = "GB"
 End If
 niceSize = "" & size & units
End Function
'*************************************************************************************
elseif scriptStatus = "OFF" then
maillog.subject = "ATTENTION: RE: The yo yo logs and files deletion script did not run properly"
	cleanupOFF = "The script is turned off"
	'wscript.echo cleanupOFF
	strbody = cleanupOFF
	maillog.textbody = strbody
end if
 
maillog.send
Set maillog = nothing

Open in new window

0
 
LVL 14

Assisted Solution

by:rejoinder
rejoinder earned 350 total points
ID: 22674501
Try this version.
'http://www.experts-exchange.com/Programming/Languages/Visual_Basic/VB_Script/Q_23782628.html
'<<<<<<<<<<<<DEFINE VARIABLES HERE-BEGIN>>>>>>>>>>>>>>>>>>
DIM cutoff, curyear, scriptStatus, mailto, mailfrom, maillog, sorry, intDeleted
'DEFINE CUTOFF DATE (LOG FILES OF DATES OLDER THAN THIS DATE SHOULD BE DELETED)
'SPECIFY CUTOFF DATE IN CENTER PARAMETER
	cutoff = dateadd("d", -10, date)'wscript.echo "Cut off=" & cutoff
'SPECIFY ERROR MESSAGE IF THERE ARE NO FILES TO PROCESS
	sorry = "Sorry, there are no files to delete that are older than 10 days in the "
'GET CURRENT YEAR FOR REGULAR EXPRESSION TO PERFORM LOG DELETION 
	curyear = year(now) 'wscript.echo "Current Year=" & curyear
'PARAMETER TO ENABLE LOGS TO BE DELETED
'SET TO 'ON' TO ENABLE 'OFF' TO DISABLE
	scriptStatus = "ON"
'EMAIL TO ADDRESS (Add multiple by seperating with commas)
	mailto = "me@me.com"
'EMAIL FROM ADDRESS (Add multiple by seperating with commas)
	mailfrom = "me@me.com"
'<<<<<<<<<<<<DEFINE VARIABLES HERE-END>>>>>>>>>>>>>>>>>>
 
'++++++++++++++++++++++++EMAIL CONFIGURATION BEGIN++++++++++++++++++++++++++++++++++
set maillog = createobject("CDO.Message") 
'This section provides the configuration information for the remote SMTP server.
maillog.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2 'Send the message using the network (SMTP over the network).
maillog.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserver") ="mx01exchange.me.com"
maillog.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25 
maillog.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = False 'Use SSL for the connection (True or False)
maillog.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 30
maillog.Configuration.Fields.Update
'End remote SMTP server configuration section==
maillog.from = mailfrom
maillog.to = mailto
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
if scriptStatus = "ON" then
	'DELETE ALL LOG AND TEMP FILES CONFIGURATION
	
	'ADD TEMP FILE DIRECTORIES TO THE ARRAY TO DISPLAY THEM IN THE EMAIL
	arrayHeaders = array("AccountSystem", "AsyncQueue", "Common", "Login", "Publishing", "Shared")
	
	'ADD A CASE STATEMENT FOR EACH DIRECTORY OF FILES THAT SHOULD BE DELETED
	for each strHeader in arrayHeaders
		strbody = strbody & vbCRLF & strHeader & vbCRLF
		select case strHeader
			Case "AccountSystem" 'DELETE ALL ACCOUNTSYSTEM LOG FILES
			cleanup  "D:\MyApp\LOG\Accountsystem", "^"&curyear& ".*?\.log$", cutoff
			
			Case "AsyncQueue" 'DELETE ALL ASYNCQUEUE LOG FILES
			cleanup  "D:\MyApp\LOG\AsyncQueue", "^"&curyear& ".*?\.xml$", cutoff
			
			Case "Common" 'DELETE ALL COMMON LOG FILES
			cleanup  "D:\MyApp\LOG\Common", "^"&curyear& ".*?\.log$", cutoff
			
			Case "Login" 'DELETE ALL LOGIN LOG FILES
			cleanup  "D:\MyApp\LOG\Login", "^"&curyear& ".*?\.log$", cutoff
			
			Case "Publishing" 'DELETE ALL PUBLISHING LOG FILES
			cleanup  "D:\MyApp\LOG\Publishing", "^"&curyear& ".*?\.xml$", cutoff
			cleanup  "D:\MyApp\LOG\Publishing", "^"&curyear& ".*?\.conf$", cutoff
			
			Case "Shared" 'DELETE ALL SHARED LOG FILES
			cleanup  "D:\MyApp\LOG\Shared", "^"&curyear& ".*?\.log$", cutoff
			
		End Select
	Next
elseif scriptStatus = "OFF" then
	maillog.subject = "ATTENTION: RE: The yo yo logs and files deletion script did not run properly"
	cleanupOFF = "The script is turned off"
	'wscript.echo cleanupOFF
	strbody = cleanupOFF
	maillog.textbody = strbody
end if
maillog.textbody = maillog.textbody & vbCRLF & "Total Files deleted = " & intDeleted
maillog.send
Set maillog = nothing
'******************FUNCTIONS USED TO DELETE FILES************************************
Sub cleanup(folderName, pattern, cutoff)
	Set fso    = createobject("scripting.filesystemobject")
	Set folder = fso.getfolder(folderName)
	Set files  = folder.files
	Set re     = new regexp
	re.Pattern = pattern
	countFiles = 0
	countSize  = 0
        strbody = maillog.textbody
	For each file in files
		'CHECK THE REGULAR EXPRESSION
		If re.Test(file.name) Then
		 	'IF THE DATELASTMODIFIED IS LESS THAN THE CUTOFF DATE THEN DELETE THE FILE
			If file.datelastmodified < cutoff Then
				countFiles = countFiles + 1
		 		countSize = countSize + file.Size
				strbody = strbody & vbCrLf & countFiles & ":" &  "Deleted-> " & file.name &" last modified: " & file.datelastmodified & vbCrLf
				maillog.textbody = strbody
				On Error Resume Next
				file.delete
			End If
		End If
	Next
        intDeleted = intDeleted + countFiles
	if countFiles = 0 then
		strbody = strbody & vbCRLF & sorry & strHeader & " directory" & vbCRLF
		maillog.textbody = strbody
	end if
	maillog.subject = "ATTENTION: Logs and files older than " & cutoff & " have been deleted!"
	Set re          = Nothing
	Set files       = Nothing
	Set folder      = Nothing
	Set fso         = Nothing
End Sub
 
Function niceSize(size)
	units = "B"
	If size > 1024 Then
		size = Round(size / 1024, 1)
		units = "kB"
	End If
	If size > 1024 Then
		size = Round(size / 1024, 2)
		units = "MB"
	End If
	If size > 1024 Then
		size = Round(size / 1024, 3)
		units = "GB"
	End If
	niceSize = "" & size & units
End Function

Open in new window

0
 

Accepted Solution

by:
baxleyb earned 0 total points
ID: 22714923
Hi rejoinder,

I figured it out before you posted your solution. Thanks for your time. The final script is attached.
'<<<<<<<<<<<<DEFINE VARIABLES HERE-BEGIN>>>>>>>>>>>>>>>>>>
DIM cutoff, curyear, scriptStatus, mailto, mailfrom, maillog
'DEFINE CUTOFF DATE (LOG FILES OF DATES OLDER THAN THE SPECIFIED NUMBER OF DAYS WILL BE DELETED)
'SPECIFY CUTOFF DATE FOR CENTER PARAMETER
	mydate = "10"'ENTER A NUMERIC VALUE
	cutoff = dateadd("d", -mydate, date)'wscript.echo "Cut off=" & cutoff
'SPECIFY ERROR MESSAGE IF THERE ARE NO FILES TO PROCESS
	sorry = "Sorry, there are no files to delete that are older than "&mydate&" days in the "
'GET CURRENT YEAR FOR REGULAR EXPRESSION TO PERFORM LOG DELETION 
	curyear = year(now) 'wscript.echo "Current Year=" & curyear
'PARAMETER TO ENABLE LOGS TO BE DELETED
'SET TO 'ON' TO ENABLE 'OFF' TO DISABLE
	scriptStatus = "ON"
'EMAIL TO ADDRESS (Add multiple by seperating with commas)
	mailto = "me@me.com"
'EMAIL FROM ADDRESS (Add multiple by seperating with commas)
	mailfrom = "me@me.com"
'<<<<<<<<<<<<DEFINE VARIABLES HERE-END>>>>>>>>>>>>>>>>>>
'++++++++++++++++++++++++EMAIL CONFIGURATION BEGIN++++++++++++++++++++++++++++++++++
set maillog = createobject("CDO.Message") 
'This section provides the configuration information for the remote SMTP server.
maillog.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2 'Send the message using the network (SMTP over the network).
maillog.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserver") ="mx01exchange.me.com"
maillog.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25 
maillog.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = False 'Use SSL for the connection (True or False)
maillog.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 30
maillog.Configuration.Fields.Update
'End remote SMTP server configuration section==
maillog.from = mailfrom
maillog.to = mailto
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
if scriptStatus = "ON" then
'DELETE ALL LOG AND TEMP FILES CONFIGURATION
 
'ADD TEMP FILE DIRECTORIES TO THE ARRAY TO DISPLAY THEM IN THE EMAIL
arrayHeaders = array("AccountSystem", "AsyncQueue", "Common", "Login", "Publishing", "Shared")
 
'ADD A CASE STATEMENT FOR EACH DIRECTORY OF FILES THAT SHOULD BE DELETED
for each strHeader in arrayHeaders
	strbody = strbody & vbCRLF & strHeader & vbCRLF
	select case strHeader
	Case "AccountSystem" 'DELETE ALL ACCOUNTSYSTEM LOG FILES
	cleanup  "D:\MyApp\LOG\Accountsystem", "^"&curyear& ".*?\.log$", cutoff
	
	Case "AsyncQueue" 'DELETE ALL ASYNCQUEUE LOG FILES
	cleanup  "D:\MyApp\LOG\AsyncQueue", "^"&curyear& ".*?\.xml$", cutoff
	
	Case "Common" 'DELETE ALL COMMON LOG FILES
	cleanup  "D:\MyApp\LOG\Common", "^"&curyear& ".*?\.log$", cutoff
		
	Case "Login" 'DELETE ALL LOGIN LOG FILES
	cleanup  "D:\MyApp\LOG\Login", "^"&curyear& ".*?\.log$", cutoff
	
	Case "Publishing" 'DELETE ALL PUBLISHING LOG FILES
	cleanup  "D:\MyApp\LOG\Publishing", "^"&curyear& ".*?\.xml$", cutoff
	cleanup  "D:\MyApp\LOG\Publishing", "^"&curyear& ".*?\.conf$", cutoff
	
	Case "Shared" 'DELETE ALL SHARED LOG FILES
	cleanup  "D:\MyApp\LOG\Shared", "^"&curyear& ".*?\.log$", cutoff
	
	End Select
Next
'******************FUNCTIONS USED TO DELETE FILES************************************
'#######DELETE FILE FUNCTION#########
Sub cleanup(folderName, pattern, cutoff)
Set fso = createobject("scripting.filesystemobject")
Set folder = fso.getfolder(folderName)
Set files = folder.files
Set re = new regexp
	re.Pattern = pattern
	countFiles = 0
	countSize = 0
For each file in files
	
'CHECK THE REGULAR EXPRESSION
If re.Test(file.name) Then
 	'IF THE DATELASTMODIFIED IS LESS THAN THE CUTOFF DATE THEN DELETE THE FILE
	If file.datelastmodified < cutoff Then
	'wscript.echo "Deleting " & file.name &" last modified: " & file.datelastmodified
	countFiles = countFiles + 1
 		countSize = countSize + file.Size
		strbody = strbody &vbCrLf & countFiles & ":" &  "Deleted-> " & file.name &" last modified: " & file.datelastmodified & vbCrLf
		'maillog.textbody = strbody
	On Error Resume Next
	file.delete
		
	End If
	
	
 End If
 		
Next
'wscript.echo "Deleted " & countFiles & " files from " & folderName & " [" & niceSize(countSize) & "]"
		'IF THERE ARE NO MORE FILES TO PROCESS THEN APPLY THE SORRY MESSAGE TO THE EMAIL MESSAGE
			if countFiles = 0 then
				strbody = strbody & vbCRLF & sorry & strHeader & " directory" & vbCRLF
			end if
	'ADD UP THE TOTAL FILES DELETED AND APPEND TO THE BOTTOM OF THE DIRECTORY LIST OF THE EMAIL MESSAGE
	strbody = strbody &vbCrLf & "Deleted " & countFiles & " files from " & folderName & " [" & niceSize(countSize) & "]" &vbCrLf 
	maillog.subject = "ATTENTION: Logs and files older than " & cutoff & " have been deleted!"
 Set re = Nothing
 Set files = Nothing
 Set folder = Nothing
 Set fso = Nothing
End Sub
'#######FILE SIZE ROUNDUP FUNCTION#########
Function niceSize(size)
 units = "B"
 If size > 1024 Then
 size = Round(size / 1024, 1)
 units = "kB"
 End If
 If size > 1024 Then
 size = Round(size / 1024, 2)
 units = "MB"
 End If
 If size > 1024 Then
 size = Round(size / 1024, 3)
 units = "GB"
 End If
 niceSize = "" & size & units
End Function
'*************************************************************************************
elseif scriptStatus = "OFF" then
maillog.subject = "ATTENTION: The Yowzer logs and files deletion script did not run properly"
	cleanupOFF = "The script is turned off"
	'wscript.echo cleanupOFF
	strbody = cleanupOFF
	maillog.textbody = strbody
end if
 
'SEND THE EMAIL
maillog.textbody = strbody
maillog.send
Set maillog = nothing

Open in new window

0
 

Author Comment

by:baxleyb
ID: 22714967
Question answered.
0

Featured Post

Free Tool: Site Down Detector

Helpful to verify reports of your own downtime, or to double check a downed website you are trying to access.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

This is an addendum to the following article: Acitve Directory based Outlook Signature (http://www.experts-exchange.com/Programming/Languages/Visual_Basic/VB_Script/Q_24950055.html) The script is fine, and works in normal client-server domains…
When you see single cell contains number and text, and you have to get any date out of it seems like cracking our heads.
Email security requires an ever evolving service that stays up to date with counter-evolving threats. The Email Laundry perform Research and Development to ensure their email security service evolves faster than cyber criminals. We apply our Threat…
I've attached the XLSM Excel spreadsheet I used in the video and also text files containing the macros used below. https://filedb.experts-exchange.com/incoming/2017/03_w12/1151775/Permutations.txt https://filedb.experts-exchange.com/incoming/201…

809 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question