Auto delete tasks in Outlook

[bodmin]

Hi guys,

Been having a look at writing some code to automatically remove tasks from a users task list after they have been completed for a certain period of time.

Wanted to check through all tasks in the specific users calender and if they have passed the time period delete the task and send a completion email to another user.

Has anybody got any ideas how I would go about coding this?

any directions or code would be great

thanks

 

[bodmin]

Right I think I have found the code needed to do this, just in case someone else needs to do something similar thought I would post my code.

Private Sub Application_Startup()
Set myolapp = CreateObject("Outlook.Application")
Set myNameSpace = myolapp.GetNamespace("MAPI")
Set myFolder = myNameSpace.GetDefaultFolder(olFolderTasks)

myEntryID = myFolder.EntryID
myStoreID = myFolder.StoreID

Set myFolder = myNameSpace.GetFolderFromID(myEntryID, myStoreID)

Count = myFolder.Items.Count
If Count > 0 Then

Set myItem = myFolder.Items.GetFirst

LoopCount = 0
Do While LoopCount < Count
If myItem.Complete = True Then
ThisCompletedDate = myItem.DateCompleted
TodayDate = Now()
DateSinceCompletion = DateDiff("w", ThisCompletedDate, TodayDate, vbMonday)
If DateSinceCompletion = 10 Then
myItem.Delete
End If
End If
LoopCount = LoopCount + 1
If LoopCount < Count Then
Set myItem = myFolder.Items.GetNext
End If
Loop

End If



End Sub

 

[WinblowsME]

Based on your code.

Private Sub Delete_Tasks()
   Dim ol_app As Outlook.Application, ns As Outlook.NameSpace, task_folder As Outlook.MAPIFolder
   Dim mail_item As Outlook.MailItem, task_item As Outlook.TaskItem
   Dim date_complete As Date, weeks_complete As Integer, body As String
   
   Set ol_app = CreateObject("Outlook.Application")
   Set ns = ol_app.GetNamespace("MAPI")
   Set task_folder = ns.GetDefaultFolder(olFolderTasks)

   For i = task_folder.Items.Count To 1 Step -1
      Set task_item = task_folder.Items.item(i)
      
      If task_item.Complete = True Then
         date_complete = task_item.DateCompleted
         weeks_complete = DateDiff("w", date_complete, Now(), vbMonday)

         If weeks_complete >= 10 Then
            Set mail_item = ol_app.CreateItem(olMailItem)
            
            body = "Task Completion Date:  " & date_complete & Chr(13)
            body = body & "Task was completed " & weeks_complete & " weeks ago." & Chr(13) & Chr(13)
            body = body & task_item.body
            
            mail_item.To = "[URL unfurl="true"]www.com"[/URL]
            mail_item.subject = "Task:  " & task_item.subject
            mail_item.body = body
            mail_item.Display
            
            'mail_item.Send
            'task_item.Delete
         End If
      End If
   Next i
End Sub

 

[WinblowsME]

Forgot...

   Next i

   Set task_item = Nothing
   Set mail_item = Nothing   
   Set task_folder = Nothing
   Set ns = Nothing
   Set ol_app = Nothing