Script to delete messages older than X days

[xbipin]

take the script available and try modifying it in the part where it deletes the mail to move the mail instead

[micros72]

My question was very basic. I wan't to delete all mail older than 1 year, however I don't know where to put your code. Should it go into EventHandlers or a seperate file? And how do I execute the script. I have not done any scripting for hMailServer before. Thanks.

[xbipin]

if u simply want to delete mails older than 365 days then take the last script i posted, add 365 in days and add the inbox to folder list and run the script
to run u can run it from command prompt by typing the below with the spamclean.vbs as the script file

C:\WINDOWS\system32\cscript.exe "c:\spamclean.vbs"

[vinceanderson]

I'm trying to use xbipin's latest script but it's not working for me. I'm getting the following runtime error with VB Script:

800A000 - Subscript Out of Range, Line 60, Char 22

The only things I modified was the password for the admin account and and the to/from email address.

Any help???

Thanks as always!

[cerri]

Anyone that can modify the script to Archive instead of Delete?

It will be a lot useful!

I'm trying to do something like this

\INBOX
\INBOX.2008-Archive
\INBOX.2009-Archive
\INBOX.2010-Archive

and so on...

[adriano]

here is the final version of the script with features like, multiple folder mail deletion, email reporting and some minor code tweaks for stability and speed

happy to see how nicely my initial script evolved -- for some reason I didn't get notifications of updates to this post, and I happened to stumble on it while searching for something else on this forum.

The only thing I would add is some "sleep" time after each mailbox cleanup, to ease up on the load generated by the disk activity generated by potentially deleting lots of messages.

Something like:

Code: Select all

...
               'Else
                  'WScript.Echo SpamFolder & " folder Not Found in account " & oAccount.Address
                   WScript.Sleep 1000	
...

- Adriano

[cerri]

Adriano, can you help me with my needs?

I need to move messages, instead of delete.
May you help me?

[wlv]

I've tweaked the code slightly to access all accounts on all domains. Thought someone may find it useful.

Code: Select all

Const DAYS_TO_KEEP_MESSAGES = "7"   '' change as appropriate
Const MESSAGES_FOLDER = "Junk"     '' this will delete from the inbox folder, change as appropriate

Const HMSADMINUSER = "HMAIL_ADMINSTRATOR"
Const HMSADMINPWD = "PASSWORD"

Dim NumDeleted

'On Error Resume Next

Dim oApp
Set oApp = CreateObject("hMailServer.Application")
Call oApp.Authenticate(HMSADMINUSER, HMSADMINPWD)

For x = 0 to oApp.Domains.Count - 1
  Dim oDomain
  Set oDomain = oApp.Domains.Item(x)  
   
  For y = 0 to oDomain.Accounts.Count - 1
    Dim oAccount
	Set oAccount = oDomain.Accounts.Item(y)
	
    Dim oMessages
    Set oMessages  = oAccount.IMAPFolders.ItemByName(MESSAGES_FOLDER).Messages

    Dim iMessages

    NumDeleted = 0
    For iMessages = 0 To oMessages.Count - 1

      Dim oMessage
      Set oMessage = oMessages.Item(iMessages)

      Dim vbDate
      vbDate = CDate(Mid(oMessage.Date, 6, 20))

      If (vbDate < CDate(Now - DAYS_TO_KEEP_MESSAGES)) Then
        NumDeleted = NumDeleted + 1
        oMessages.DeleteByDBID(oMessage.ID)
      End If
    Next
	'WScript.Echo "Removed " & NumDeleted & " message(s) from account " & oAccount.Address
  Next
Next 

After modified "Junk" to "INBOX" ,this script works perfect for me ,thank you very much!

[bestactor]

Thanks for sharing it dude. I try executing the code you have shared here and found it to be working, and of course a useful one for scripting needs. We are really ready to wait for more updates. Thank you.

[nschoot]

Thanks for posting the script. I made a few changes to make the script a bit faster, but also fixed a pretty major flaw.

- Flaw: When message is deleted, the oMessages collection changes. The Count goes down and not all messages are iterated anymore, resulting in not all mails being deleted that should be deleted. Fixed this by first collecting the id's and then deleting the messages.
- It now sets the "Delete Before"-Date only once, instead of again for every message
- Use Message.InternalDate, instead of getting the date from the Date header and converting it to Date (faster). It was also giving me errors when converting some dates.
- Made the output a but more informative: Show "Delete before" date, domain name, don't show output when 0 mails removed and show grand total
- When the Message Folder does not exist for an account, it now skips it - given that On Error Resume Next is enabled. (In the old script, it would process the previous folder again. Not a big problem, but unnecessary)

Code: Select all

Option Explicit
Const DAYS_TO_KEEP_MESSAGES = "30"   '' change as appropriate
Const MESSAGES_FOLDER = "Junk"     '' this will delete from the inbox folder, change as appropriate

Const HMSADMINUSER = "AdminLoginName"
Const HMSADMINPWD = "AdminPassword"

Dim NumDeleted
Dim GrandTotal: GrandTotal = 0
Dim x,y
On Error Resume Next

Dim oApp
Set oApp = CreateObject("hMailServer.Application")
Call oApp.Authenticate(HMSADMINUSER, HMSADMINPWD)

Dim dOldestDate
dOldestDate = CDate(Now - DAYS_TO_KEEP_MESSAGES)
WScript.Echo "Deleting messages older than: " & dOldestDate

For x = 0 to oApp.Domains.Count - 1
	Dim oDomain
	Set oDomain = oApp.Domains.Item(x)  
	WScript.Echo "Domain: " & oDomain.Name
	
	For y = 0 to oDomain.Accounts.Count - 1
		NumDeleted = 0
		Dim oAccount
		
		Set oAccount = oDomain.Accounts.Item(y)
		Dim oMessages
		
		Set oMessages  = oAccount.IMAPFolders.ItemByName(MESSAGES_FOLDER).Messages
		If Not IsNull(oMessages) then

			Dim iMessages
			Dim MessagesToDelete: MessagesToDelete = Array()
			ReDim MessagesToDelete(oMessages.Count)

			For iMessages = 0 to oMessages.Count - 1
				Dim oMessage
				Set oMessage = oMessages.Item(iMessages)
				If oMessage.InternalDate < dOldestDate Then					
					MessagesToDelete(NumDeleted) = oMessage.ID				
					NumDeleted = NumDeleted + 1			
				End If
			Next
			For iMessages = 0 to NumDeleted - 1
				oMessages.DeleteByDBID(MessagesToDelete(iMessages))	
			Next
			If NumDeleted > 0 then
				WScript.Echo "Removed " & NumDeleted & " message(s) from account " & oAccount.Address
				GrandTotal = GrandTotal + NumDeleted
			End If
			oMessages = Empty
		End If
	Next
Next 
WScript.Echo "Removed a total of " & GrandTotal & " message(s)."

[mattg]

Thanks for the update, and posting your updated script

[black zero]

Thanks for posting the script. I made a few changes to make the script a bit faster, but also fixed a pretty major flaw.

- Flaw: When message is deleted, the oMessages collection changes. The Count goes down and not all messages are iterated anymore, resulting in not all mails being deleted that should be deleted. Fixed this by first collecting the id's and then deleting the messages.
- It now sets the "Delete Before"-Date only once, instead of again for every message
- Use Message.InternalDate, instead of getting the date from the Date header and converting it to Date (faster). It was also giving me errors when converting some dates.
- Made the output a but more informative: Show "Delete before" date, domain name, don't show output when 0 mails removed and show grand total
- When the Message Folder does not exist for an account, it now skips it - given that On Error Resume Next is enabled. (In the old script, it would process the previous folder again. Not a big problem, but unnecessary)

Code: Select all

Option Explicit
Const DAYS_TO_KEEP_MESSAGES = "30"   '' change as appropriate
Const MESSAGES_FOLDER = "Junk"     '' this will delete from the inbox folder, change as appropriate

Const HMSADMINUSER = "AdminLoginName"
Const HMSADMINPWD = "AdminPassword"

Dim NumDeleted
Dim GrandTotal: GrandTotal = 0
Dim x,y
On Error Resume Next

Dim oApp
Set oApp = CreateObject("hMailServer.Application")
Call oApp.Authenticate(HMSADMINUSER, HMSADMINPWD)

Dim dOldestDate
dOldestDate = CDate(Now - DAYS_TO_KEEP_MESSAGES)
WScript.Echo "Deleting messages older than: " & dOldestDate

For x = 0 to oApp.Domains.Count - 1
	Dim oDomain
	Set oDomain = oApp.Domains.Item(x)  
	WScript.Echo "Domain: " & oDomain.Name
	
	For y = 0 to oDomain.Accounts.Count - 1
		NumDeleted = 0
		Dim oAccount
		
		Set oAccount = oDomain.Accounts.Item(y)
		Dim oMessages
		
		Set oMessages  = oAccount.IMAPFolders.ItemByName(MESSAGES_FOLDER).Messages
		If Not IsNull(oMessages) then

			Dim iMessages
			Dim MessagesToDelete: MessagesToDelete = Array()
			ReDim MessagesToDelete(oMessages.Count)

			For iMessages = 0 to oMessages.Count - 1
				Dim oMessage
				Set oMessage = oMessages.Item(iMessages)
				If oMessage.InternalDate < dOldestDate Then					
					MessagesToDelete(NumDeleted) = oMessage.ID				
					NumDeleted = NumDeleted + 1			
				End If
			Next
			For iMessages = 0 to NumDeleted - 1
				oMessages.DeleteByDBID(MessagesToDelete(iMessages))	
			Next
			If NumDeleted > 0 then
				WScript.Echo "Removed " & NumDeleted & " message(s) from account " & oAccount.Address
				GrandTotal = GrandTotal + NumDeleted
			End If
			oMessages = Empty
		End If
	Next
Next 
WScript.Echo "Removed a total of " & GrandTotal & " message(s)."

I changed it to 'INBOX' and it worked flawlessly.

How to modify so it runs for both INBOX and JUNK?

[jimimaseye]

use this version of the same script on this thread: viewtopic.php?f=20&t=15363#p124804
With it you can add the folder list by separating with the pipe "|" (ie "trash|Spam|inbox")

ALTERNATIVELY.... if you really want to hack around yourself, a suggestion....

Set an ARRAY up and then loop through for each item in the array

Code: Select all

 Dim arrayFolder(5,1), C
   arrayFolder(0,0)= "INBOX"      'CHANGE ME
   arrayFolder(1,0)= "TRASH"      'CHANGE ME 
   arrayFolder(2,0)= "SPAM"      'CHANGE ME
                 'Add more as needed, and ensure count does not exceed DIM attributes for arrayFolder
.
.
      Set oAccount = oDomain.Accounts.Item(y)                     <<--- existing line
      Dim oMessages                                                 <<--- existing line

 for C = 0 to uBound(arrayFolder)
   MESSAGES_FOLDER = C
 
Set oMessages  = oAccount.IMAPFolders.ItemByName(MESSAGES_FOLDER).Messages    <<--- existing line
      If Not IsNull(oMessages) then                                             <<--- existing line

[jimimaseye]

FOR THE RECORD the above scripts were flawed.

The problem was that there were certain conditions where there was a caching of records hanging on to 'deleted records'

ie, The FOR loop would start off by seeing an oMessage.Count of (for example) 5 when in reality there was only 4 messages. Ultimately this caused a Subscript Out Of Range error.

It has been re-jigged to cope for this and the fully tested and working version is here: RESOLVED: viewtopic.php?p=173427#p173427

[jimimaseye]

This RESOLVED script had a minor bug if searching for 3+ level deep trash folder (unlikely but even so...). It was reported by a user.

It has now been completely resolved. See here: viewtopic.php?p=175114#p175114 for further information and the new FIXED working script (I no longer post the copy here because of unnecessary duplication). The new version also allows WILDCARD for folders.

[ObiWan]

How do I implement this script? Can't find any good documentation about scripts.

start here and move on to this section in short, read the manual, it's there for a good reason