|
OLKeeper
|
OLKeeper reliably prevents users from closing their Outlook window and thus possibly missing reminders or e-mails. |
You can set via folder properties if and when the folder should be archived. Of course, if you like you can also built your own solution. This sample archives all items of the default calendar that have reached a certain age to another folder.
Public Sub ArchivItems()
Dim SrcFolder As Outlook.MAPIFolder
Dim DestFolder As Outlook.MAPIFolder
Dim Items As Outlook.Items
Dim obj As Object
Dim Appt As Outlook.AppointmentItem
Dim Ns As Outlook.NameSpace
Dim DueDate As Date
Dim i&
Dim Counter&
Set Ns = Application.GetNamespace("MAPI")
'Select Archive folder
Set DestFolder = Ns.PickFolder
If DestFolder Is Nothing Then Exit Sub
'Set the age, archive if older than 7 days
DueDate = DateAdd("d", -7, Now)
'Archive from default calendar
Set SrcFolder = Ns.GetDefaultFolder(olFolderCalendar)
Set Items = SrcFolder.Items
For i = Items.Count To 1 Step -1
Set obj = Items(i)
If TypeOf obj Is Outlook.AppointmentItem Then
Set Appt = obj
If DateDiff("s", Appt.End, DueDate, vbUseSystemDayOfWeek, vbUseSystem) > 0 Then
Appt.Move DestFolder
Counter = Counter + 1
End If
End If
Next
MsgBox Counter & " items have been moved", vbInformation
End Sub