Implementing GTD on Outlook–Part 1–UPDATE

Link to original post

 

I have updated to code to add below items --

1. Start date – date of receiving email

2. Due date – start date + 3

3. Reminder to turn on

4. Reminder date – Due date

   1:  Option Compare Text

   2:   

   3:  Sub MakeWaitingForTaskWithAttachmentFromCurrentMessage(MyMail As Outlook.MailItem)

   4:      Dim strID As String

   5:      Dim olNS As Outlook.NameSpace

   6:      Dim olMail As Outlook.MailItem

   7:      Dim objTask As Outlook.TaskItem

   8:      Dim categories As String

   9:      Dim addRecipient As Boolean

  10:      Dim regex

  11:      Dim matches, customSubject, subject

  12:      

  13:      ' Configuration options

  14:      categories = "@WAITING FOR"

  15:      addRecipient = True

  16:      

  17:      strID = MyMail.EntryID

  18:      Set olNS = Application.GetNamespace("MAPI")

  19:      Set olMail = olNS.GetItemFromID(strID)

  20:      Set objTask = Application.CreateItem(olTaskItem)

  21:      objTask.Attachments.Add MyMail

  22:      Set regex = CreateObject("vbscript.regexp")

  23:      regex.Pattern = "/wf (.*)"

  24:      regex.IgnoreCase = True

  25:      regex.Global = True

  26:      Set matches = regex.Execute(olMail.Body)

  27:      If matches.Count <> 0 Then

  28:          customSubject = matches(0).submatches(0)

  29:      Else

  30:          customSubject = ""

  31:      End If

  32:      If customSubject <> "" Then

  33:          subject = customSubject

  34:      Else

  35:          subject = olMail.subject

  36:      End If

  37:      

  38:      With objTask

  39:          If addRecipient Then

  40:              .subject = olMail.Recipients.item(1) & ": " & subject

  41:          Else

  42:              .subject = subject

  43:          End If

  44:          .categories = categories

  45:          .Body = olMail.Body

  46:          .StartDate = olMail.ReceivedTime

  47:          .DueDate = olMail.ReceivedTime + 3

  48:          .ReminderSet = True

  49:          .ReminderTime = olMail.ReceivedTime + 3

  50:   

  51:      End With

  52:      objTask.Save

  53:       

  54:      Set objTask = Nothing

  55:      Set olMail = Nothing

  56:      Set olNS = Nothing

  57:  End Sub

  58:   

  59:  ' Wrapper that gets the current item and calls the previous function, to use as a macro

  60:  Sub MakeWaitingForTaskWithAttachmentFromCurrentMessageMacro()

  61:      Dim curMail As Outlook.MailItem

  62:      Set curMail = GetCurrentItem()

  63:      Call MakeWaitingForTaskWithAttachmentFromCurrentMessage(curMail)

  64:  End Sub

  65:   

  66:      

  67:   

  68:  Function GetCurrentItem() As Object

  69:      Dim objApp As Outlook.Application

  70:           

  71:      Set objApp = CreateObject("Outlook.Application")

  72:      On Error Resume Next

  73:      Select Case TypeName(objApp.ActiveWindow)

  74:          Case "Explorer"

  75:              Set GetCurrentItem = objApp.ActiveExplorer.Selection.item(1)

  76:          Case "Inspector"

  77:              Set GetCurrentItem = objApp.ActiveInspector.CurrentItem

  78:          Case Else

  79:              ' anything else will result in an error, which is

  80:              ' why we have the error handler above

  81:      End Select

  82:       

  83:      Set objApp = Nothing

  84:  End Function

 

This code is for waiting for category.