| Sub Initialize |
| |
| 'Inbox Maintenance |
| 'Periodisches Aufräumen des Meileingangs zur Performanceverbesserung |
| |
| Const archiveFolder = "Maileingang - Archiv" 'Name des anzulegenden Ordners |
| Const inboxLimit = 200 'Anzahl Dokumente |
| Const maxAge = 30 'in Tagen |
| |
| Dim ses As New NotesSession |
| Dim currentDb As NotesDatabase |
| Dim inbox As NotesView |
| Dim allEntries As NotesViewEntryCollection |
| Dim mailEntry As NotesViewEntry |
| Dim mailDoc As NotesDocument |
| Dim moveDoc As NotesDocument |
| Dim movedDocs As Integer |
| Dim mailCreated As NotesDateTime |
| Dim cutoffDate As NotesDateTime |
| |
| Set currentDb = ses.CurrentDatabase |
| |
| 'Eingangsordner heranziehen |
| Set inbox = currentDb.GetView("($Inbox)") |
| |
| 'Prüfen, wie viele Dokumente im Eingang liegen; wenn Limit überschritten, aktiv werden |
| If (inbox.EntryCount > inboxLimit) Then |
| |
| 'Wenn Schwellwert überschritten, alls Mails die älter sind als x Tage in Archiv verschieben |
| Set cutoffDate = New NotesDateTime(Cstr(Today)) |
| Call cutoffDate.AdjustDay(-1 * maxAge) |
| Set mailCreated = New NotesDateTime("") |
| |
| Set allEntries = inbox.AllEntries |
| Set mailEntry = allEntries.GetFirstEntry |
| |
| While Not (mailEntry Is Nothing) |
| |
| Set mailDoc = mailEntry.Document |
| mailCreated.LSLocalTime = mailDoc.Created |
| |
| If (cutoffDate.TimeDifference(mailCreated) > 0) Then |
| |
| Set moveDoc = mailDoc |
| |
| End If '(cutoffDate.TimeDifference(mailCreated) > 0) |
| |
| Set mailEntry = allEntries.GetNextEntry(mailEntry) |
| |
| If Not (moveDoc Is Nothing) Then |
| |
| movedDocs = movedDocs + 1 |
| |
| Call moveDoc.PutInFolder(archiveFolder, True) |
| Call moveDoc.RemoveFromFolder("($Inbox)") |
| |
| Set moveDoc = Nothing |
| |
| End If 'Not (moveDoc Is Nothing) |
| |
| Wend 'Not (mailDoc Is Nothing) |
| |
| End If '(inbox.EntryCount > inboxLimit) |
| |
| End Sub |