DominoArea.org [Archive]

On Error Resume Next
Dim directory As New NotesdbDirectory ("")
Dim ndb As NotesDatabase
Dim doc As notesdocument
Dim rtitem As NotesRichTextItem
Set fdb=directory.GetFirstDataBase(DATABASE)
While Not fdb Is Nothing
Print "Will Get Next Database"
Set ndb=directory.GetNextDataBase
If Left(fdb.filepath,5)="mail\" Then
Call fdb.open("","")
If fdb.Size>78643200 Then
Set doc=fdb.createdocument
doc.Subject="Your mailbox size has exceeded 75 Mbytes"
Set rtitem = doc.CreateRichTextItem("body")
Call rtitem.appendText ("Your mailbox size has exceeded the capacity it supposed to be."&Chr(13)&"Currently the limit available is 75 MBytes. Your mailbox size is now: " &Str(Cint(fdb.size/1048576))&" MBytes."&Chr(13)&"Please delete some e-mail messages or reduce the number of days that e-mail messages are kept on the server" _
&Chr(13)&"If you still don't know what to do please contact your computer support team or the e-mail administrator."&Chr(13)&Chr(13)&"Thank you for your understanding."&Chr(13)&"Your e-mail Administrator.")
doc.from="NotesAdministrator@company.gr"
doc.SendTo="Intended Recipients"
doc.replyTo="NotesTeam@company.gr"
doc.DeliveredDate=Now
doc.PostedDate=Now
doc.RouteServers="mail.company.gr/DOL"
doc.RouteTimes=Now
doc.SMTPOriginator="NotesTeam@company.gr"
Call doc.save(False,False)
Call doc.PutInFolder("($Inbox)")
End If
End If
Print fdb.filepath
Set fdb=ndb
Set doc = Nothing
Wend