I have this script that runs nightly. It was created in conjunction with help I received here on the forum (I think from Doom or Matt, and the original script is found somewhere here on this forum). It generally works well.
You can see by the code that it is coded correctly (hopefully!) by the way it uses the FOR loops to check the individual TRASH folders and delete qualifying messages (by message age) in them for each account. Basically, it looks in the TRASH folder, collects the .ID of a message that satisfy selection criteria and then performs a oMessages.DeleteByDBID(oMessage.ID) of that message.
However, occasionally (say every 2 or 3 days) it errors with:
... so far in (having already done some accounts and yet got other accounts to do). The account it fails on can change, as can the amount of emails it finds (in other words there is nothing obviously symptomatic. And yet, another day, another run, and it all completes in one go as it should do. By the way, when it does fail, a second run of the same script does then complete ok (starting at the messages yet to be deleted left behind by the aborted first run). It seems that despite finding a message and obtaining its ID, the 'DeleteByID' call fails to find that message (Or at least Im guessing thats what the problem is).Delete failed
9 Srce: Microsoft VBScript runtime error Desc: Subscript out of range
Im wondering if anyone can see an obvious problem or if the error is somewhere within the Hmailserver API handling? (I have marked/highlighted the 4 main lines with <--- about 2 thirds down the code)
Code: Select all
Const DAYS_TO_KEEP_MESSAGES = "0" ' Days old to keep mails Const MESSAGES_FOLDER = "trash" ' Folder to delete from, case insensitive, subfolder delimiter needs to be as below (.) based on ur delimiter setting in hmailserver, multiple fodlers can be specified seprated by | (pipe) eg: "spam|trash|deleted messages|deleted items|junk e-mail" Const IMAP_DELIMITER = "." ' This needs to be same as what u used above for subfodlers based on delimiter setting in hmailserver Const ADMINUSER = "Administrator" ' Admin username Const ADMINPWD = "secretpassword" ' Admin password Const FROM_EMAIL = "email@example.com" ' Replace this with the email address you want the report to come from Const REPORT_TO_EMAIL = "firstname.lastname@example.org" ' Replace this with the email address you want the report to be sent to Dim mFolders Dim oApp Dim AccountSize Dim NumMsgs Dim NumDeleted Dim FoundFolder Dim FolderList Dim aFolder Dim Message Dim ReturnValue ReturnValue = 0 On Error Resume Next mFolders = Split(MESSAGES_FOLDER, "|") Set oApp = CreateObject("hMailServer.Application") Call oApp.Authenticate(ADMINUSER, ADMINPWD) For x = 0 to oApp.Domains.Count - 1 Dim oDomain Set oDomain = oApp.Domains.Item(x) If oDomain.Active Then For y = 0 to oDomain.Accounts.Count - 1 Dim oAccount Set oAccount = oDomain.Accounts.Item(y) OutputMsg = OutputMsg & "<tr><td colspan=""5""> </td></tr>" & vbCrLf If oAccount.Active Then For each SpamFolder in mFolders AccountSize = 0 NumMsgs = 0 NumDeleted = 0 xFolder = "" Dim FindFolders Set FindFolders = oAccount.IMAPFolders FoundFolder = False FolderList = ListFolders(FindFolders, 0, "") aFolder = Split(Left(FolderList, Len(FolderList) - 1), "|") For each z in aFolder If UCase(z) = UCase(Trim(SpamFolder)) Then FoundFolder = True SpamFolder = z Exit For End If Next If FoundFolder Then Dim oMessages Set oMessages = GetInsideFolders(oAccount.IMAPFolders, SpamFolder) NumMsgs = oMessages.Count If oMessages.Count > 0 Then '<--- message found Dim iMessages For iMessages = (oMessages.Count) To 1 step -1 '<--- individual message selected Dim oMessage Set oMessage = oMessages.Item(iMessages - 1) AccountSize = AccountSize + oMessage.Size Dim vbDate vbDate = oMessage.InternalDate If (vbDate < CDate(Now - DAYS_TO_KEEP_MESSAGES)) Then ' <--- message qualifies for deletion NumDeleted = NumDeleted + 1 oMessages.DeleteByDBID(oMessage.ID) ' <--- Deletion called If Err.Number <> 0 Then ShowError("Delete failed") Exit For End If End If Next End If WScript.Echo "Removed " & NumDeleted & " message(s) from " & SpamFolder & " folder in account " & oAccount.Address & vbCrLf OutputMsg = OutputMsg & "<tr><td>" & oAccount.Address & "</td>" OutputMsg = OutputMsg & "<td>" & SpamFolder & "</td>" OutputMsg = OutputMsg & "<td align=""right"">" & FormatNumber(NumMsgs, 0, True, False, True) & "</td>" OutputMsg = OutputMsg & "<td align=""right"">" & FormatNumber(AccountSize, 0, True, False, True) & "K</td>" OutputMsg = OutputMsg & "<td align=""right"">" & FormatNumber(NumDeleted, 0, True, False, True) & "</td></tr>" & vbCrLf Else WScript.Echo SpamFolder & " folder Not Found in account " & oAccount.Address End If Next End If Next End If Next OutputMsg = "<font face=""Calibri""><table border=""1""><tr><td><b>Email Account</b></td><td><b>Folder</b></td><td><b>Mail Count</b></td><td><b>Mail Size</b></td><td><b>Deleted</b></td></tr>" & vbCrLf & OutputMsg OutputMsg = OutputMsg & "</table>" & vbCrLf Dim CreateGUIDval CreateGUID Set Message = CreateObject("hMailServer.Message") Message.HeaderValue("Message-ID") = "<" & CreateGUIDval & ">" Message.FromAddress = FROM_EMAIL Message.From = "Email Clearup <" & FROM_EMAIL & ">" Message.AddRecipient "System Administrator", REPORT_TO_EMAIL Message.Subject = "Email Clearup deletion report" Message.HTMLBody = OutputMsg Message.Save Wscript.Quit ReturnValue Function ShowError(strMessage) WScript.Echo strMessage WScript.Echo Err.Number & " Srce: " & Err.Source & " Desc: " & Err.Description ReturnValue = Err.Number 'Err.Clear End function Function ListFolders(obFolders, iRecursion, rootFolder) iRecursion = iRecursion + 1 Dim sMessage Dim i for i = 0 to obFolders.Count -1 Dim obFolder Set obFolder = obFolders.Item(i) if iRecursion > 1 then sMessage = sMessage & rootFolder & IMAP_DELIMITER & obFolder.Name & "|" else sMessage = sMessage & obFolder.Name & "|" end if sMessage = sMessage & ListFolders(obFolder.SubFolders, iRecursion, obFolder.Name) Next iRecursion = iRecursion -1 ListFolders = sMessage End Function Function GetInsideFolders(obFolders2, subFolders) Dim iRecursion2 iRecursion2 = 1 Dim SeprateFodlers SeprateFodlers = Split(subFolders, IMAP_DELIMITER) For each w in SeprateFodlers if iRecursion2 = 1 then Set obFolders2 = obFolders2.ItemByName(w) iRecursion2 = iRecursion2 + 1 Else Set obFolders2 = obFolders2.SubFolders.ItemByName(w) End If Next Set GetInsideFolders = obFolders2.Messages End Function Function CreateGUID() ' Generate a random string. Dim obUtilities Set obUtilities = CreateObject("hMailServer.Utilities") CreateGUIDval = Mid(obUtilities.GenerateGUID, 2, 36) & "@servermail" End Function