| Private Sub ClearInbox() |
| %REM |
| Beschreibung: |
| Dieses Script resduziert den Inhalt des Ordners "Eingang | ($Inbox)" auf eine maximale Anzahl von Dokumenten |
| Darüberhianus gehende Dokumente werden in einen normalen Ordner "- Ausgelagerter Eingang -" verschoben. |
| Es verbleiben die aktuellsten Dokumente. |
| %END REM |
| |
| Dim session As New NotesSession |
| Dim db As NotesDatabase |
| Dim view As NotesView |
| Dim ecol As NotesViewEntryCollection |
| Dim entry As NotesViewEntry |
| Dim doc As NotesDocument |
| Dim Auslagerungsordner As String |
| Dim wert As String |
| Dim array() As String |
| Dim vList As Variant |
| Dim i As Long |
| Dim sErrorMess As String |
| |
| On Error Goto Fehler |
| |
| Const MaxInboxEntries = 250 |
| |
| Set db = session.CurrentDatabase |
| |
| Auslagerungsordner = "- Ausgelagerter Eingang -" |
| |
| Set view = db.GetView("($Inbox)") |
| If view Is Nothing Then Goto Ende |
| view.AutoUpdate = False |
| |
| Set ecol = view.AllEntries |
| |
| If ecol.Count > MaxInboxEntries Then |
| ' Eingang zu groß |
| Redim array(MaxInboxEntries) As String |
| i = 0 |
| |
| Set entry = ecol.GetFirstEntry |
| Do While Not entry Is Nothing |
| Set doc = entry.Document |
| |
| If Cstr(doc.DeliveredDate(0)) <> "" Then |
| wert = Format(doc.DeliveredDate(0), "yyyymmdd") + Format(doc.DeliveredDate(0), "hhmmss") |
| Elseif Cstr(doc.PostedDate(0)) <> "" Then |
| wert = Format(doc.PostedDate(0), "yyyymmdd") + Format(doc.PostedDate(0), "hhmmss") |
| Else |
| wert = Format(doc.Created, "yyyymmdd") + Format(doc.Created, "hhmmss") |
| End If |
| |
| wert = wert + "~" + doc.UniversalID |
| If i > Ubound(array) Then Redim Preserve array(Ubound(array) + 100) As String |
| array( i ) = wert |
| i = i + 1 |
| |
| Set entry = ecol.GetNextEntry(entry) |
| Loop |
| |
| vList = Fulltrim(array) |
| |
| ' nach Datum absteigend sortieren |
| Call ArraySort( vList, True) |
| |
| For i = MaxInboxEntries To Ubound(vList) |
| Set doc = db.GetDocumentByUNID(Strright(vList( i ), "~")) |
| |
| Call doc.PutInFolder(Auslagerungsordner, True) |
| Call doc.RemoveFromFolder("($Inbox)") |
| Next |
| End If |
| |
| Ende: |
| Set doc = Nothing |
| Set entry = Nothing |
| Set ecol = Nothing |
| Set view = Nothing |
| Set db = Nothing |
| Exit Sub |
| |
| Fehler: |
| Msgbox "Fehler bei der Bereinigung des Eingangs: " + Error$ + " in Zeile " + Str(Erl), 16, "Fehler" |
| Resume Ende |
| End Sub |
| |
| Private Sub ArraySort( array As Variant, descending As Integer) |
| %REM |
| Parameter: |
| array (Input) - Zu sortierende Daten |
| descending (Input) - Absteigent sortieren = True, Aufsteigend = False |
| |
| Beschreibung: Sortiert ein array von Werten unter Nutzung des Shell Sort Algorithmus (Portiert aus C) |
| %END REM |
| |
| Dim aSpans(1 To 9) As Integer |
| Dim nSpanCount As Integer |
| Dim nSpanIncr As Integer |
| Dim nLimit As Integer ' Die Anzahl der zu sortierenden Werte |
| Dim nSpan As Integer |
| Dim KeyNum As Integer |
| Dim SwapEm As Integer |
| Dim SubArray(1 To 3) As Variant |
| Dim Record1Keys As Variant |
| Dim Record2Keys As Variant |
| Dim doc As notesDocument |
| Dim i As Integer |
| Dim j As Integer |
| Dim k As Integer |
| Dim Temp As Variant |
| Dim floor As Integer |
| |
| ' Definition der spans welche vom Algorithmus genutzt werden |
| aSpans(1) = 9840 |
| aSpans(2) = 3279 |
| aSpans(3) = 1093 |
| aSpans(4) = 364 |
| aSpans(5) = 121 |
| aSpans(6) = 40 |
| aSpans(7) = 13 |
| aSpans(8) = 4 |
| aSpans(9) = 1 |
| ' Die maximale Anzahl von spans |
| nSpanCount = 9 |
| ' Womit soll gestartet werden ? |
| nSpanIncr = 1 |
| floor = Lbound( array ) |
| nLimit = Ubound( array ) - floor |
| If nLimit = 1 Then Exit Sub ' Ein einzelnes Element muss nicht sortiert werden |
| |
| j = floor |
| For k = nSpanCount To 1 Step -1 |
| If aSpans(k) > nLimit Then |
| Exit For |
| End If |
| j = k |
| Next |
| i = j |
| For i = j To nSpanCount |
| nSpan = aSpans(i ) |
| For j = nSpan To nLimit |
| Temp = array(j) |
| k = j - nSpan |
| Do While k >= floor |
| Dim doSwap As Integer |
| If descending Then |
| doSwap = Temp > array(k) |
| Else |
| doSwap = Temp < array(k) |
| End If |
| |
| If doSwap Then |
| array(k + nSpan) = array(k) |
| k = k - nSpan |
| Else |
| Exit Do |
| End If |
| Loop |
| array( k + nSpan ) = Temp |
| Next j |
| Next i |
| End Sub |
| |