Implementing GTD on Outlook–Part 2

Create appointment directly from the email.
Code for same is given below

   1:  Option Explicit

   2:  Sub NewMeetingRequestFromEmail()

   3:      Dim app As New Outlook.Application

   4:      Dim item As Object

   5:      Set item = app.ActiveInspector.CurrentItem

   6:      

   7:      If item.Class <> olMail Then Exit Sub

   8:      

   9:      Dim email As MailItem

  10:      

  11:      Set email = item

  12:      

  13:      Dim meetingRequest As AppointmentItem

  14:      

  15:      Set meetingRequest = app.CreateItem(olAppointmentItem)

  16:      

  17:      meetingRequest.Categories = email.Categories

  18:      meetingRequest.Body = email.Body

  19:      meetingRequest.Subject = email.Subject

  20:      meetingRequest.Attachments.Add email

  21:      

  22:      Dim attachment As attachment

  23:      For Each attachment In email.Attachments

  24:          CopyAttachment attachment, meetingRequest.Attachments

  25:      Next attachment

  26:      

  27:      Dim recipient As recipient

  28:      

  29:      Set recipient = meetingRequest.Recipients.Add(email.SenderEmailAddress)

  30:      recipient.Resolve

  31:      

  32:      For Each recipient In email.Recipients

  33:          RecipientToParticipant recipient, meetingRequest.Recipients

  34:      Next recipient

  35:      

  36:      Dim inspector As inspector

  37:      

  38:      Set inspector = meetingRequest.GetInspector

  39:          

  40:      'inspector.CommandBars.FindControl

  41:      inspector.Display

  42:      

  43:  End Sub

  44:   

  45:  Private Sub RecipientToParticipant(recipient As recipient, participants As Recipients)

  46:      Dim participant As recipient

  47:      

  48:      If LCase(recipient.Address) <> LCase(Session.CurrentUser.Address) Then

  49:          Set participant = participants.Add(recipient.Address)

  50:          Select Case recipient.Type

  51:          Case olBCC:

  52:              participant.Type = olOptional

  53:          Case olCC:

  54:              participant.Type = olOptional

  55:          Case olOriginator:

  56:              participant.Type = olRequired

  57:          Case olTo:

  58:              participant.Type = olRequired

  59:          End Select

  60:          participant.Resolve

  61:      End If

  62:   

  63:  End Sub

  64:   

  65:  Private Sub CopyAttachment(source As attachment, destination As Attachments)

  66:      On Error GoTo HandleError

  67:      

  68:      Dim filename As String

  69:      

  70:      filename = Environ("temp") & "\" & source.filename

  71:      

  72:      source.SaveAsFile (filename)

  73:      

  74:      destination.Add (filename)

  75:      

  76:      Exit Sub

  77:      

  78:  HandleError:

  79:      Debug.Print Err.Description

  80:  End Sub

  81:   

  82:   

The code will open a pop up with the content from the current email copied to its body. Also the original email copy is attached to it (for future reference)

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.

Implementing GTD on Outlook–Part 1

This post is updated. Click here to see updated code.

 

Last few weeks I have been reading and trying to implement GTD by David Allen in my every day activities. Since Microsoft Outlook is a inseparable part of my office life, first thing I did was to install GTD addin for outlook. And I can confirm that it works. At least for me who gets at least 100-120 emails daily.

But there is a drawback with the addin. It’s a free for 30 days. Now buying this software is out of my option list, yet I had to device a way to implement the functionality in my outlook.

My requirements are-

 

1. One click creation of task from email

2. Task should contain text from email

3. Task should also have the original email as attachment

4. When I want to differ the email for later date on one click the a calendar event is created with email text in calendar event body

5. File the document as project/ Reference

 

Major activity in GTD is categorized in --

1. Action

Office

Errand

Home

Computer

2. Waiting For

3. Differed

4. Filing reference

 

Most optimum option seem to me is to create Macros for outlook. I will start with the Office Macro. Below is the code for it.

 

What it does -

1. You can create a button on outlook so that you can select a message and create a task from it by clicking the button. This will create task with text from the email and also attach email to it.

2. While sending the email to any user you can add a text as “/Office”. Later you can create an outlook rule to invoke this macro after sending email. This Macro will scan the content of email for the tags and then create a task from it with all the details as point # 1.

Tip : You can create multiple signatures with one tag in each so that while send the email you can choose one of the signature as per the requirement. Make the text with font 1 and color as white so that only Macro can read it and recipients will not come to know about it.

   1:   

   2:  Option Compare Text

   3:   

   4:   

   5:  Sub MakeOfficeTaskWithAttachmentFromCurrentMessage(MyMail As Outlook.MailItem)

   6:      Dim strID As String

   7:      Dim olNS As Outlook.NameSpace

   8:      Dim olMail As Outlook.MailItem

   9:      Dim objTask As Outlook.TaskItem

  10:      Dim categories As String

  11:      Dim addRecipient As Boolean

  12:      Dim regex

  13:      Dim matches, customSubject, subject

  14:      

  15:     

  16:      categories = "@Office"

  17:      addRecipient = True

  18:      

  19:      strID = MyMail.EntryID

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

  21:      Set olMail = olNS.GetItemFromID(strID)

  22:      Set objTask = Application.CreateItem(olTaskItem)

  23:      objTask.Attachments.Add MyMail

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

  25:      regex.Pattern = "/Office (.*)"

  26:      regex.IgnoreCase = True

  27:      regex.Global = True

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

  29:      If matches.Count <> 0 Then

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

  31:      Else

  32:          customSubject = ""

  33:      End If

  34:      If customSubject <> "" Then

  35:          subject = customSubject

  36:      Else

  37:          subject = olMail.subject

  38:      End If

  39:      

  40:      With objTask

  41:          If addRecipient Then

  42:              .subject = olMail.Recipients.Item(1) & ": " & subject

  43:          Else

  44:              .subject = subject

  45:          End If

  46:          .categories = categories

  47:          .Body = olMail.Body

  48:      End With

  49:      objTask.Save

  50:       

  51:      Set objTask = Nothing

  52:      Set olMail = Nothing

  53:      Set olNS = Nothing

  54:  End Sub

  55:   

  56:   

  57:  Sub MakeOfficeTaskWithAttachmentFromCurrentMessageMacro()

  58:      Dim curMail As Outlook.MailItem

  59:      Set curMail = GetCurrentItem()

  60:      Call MakeOfficeTaskWithAttachmentFromCurrentMessage(curMail)

  61:  End Sub

  62:   

  63:      

  64:   

  65:  Function GetCurrentItem() As Object

  66:      Dim objApp As Outlook.Application

  67:           

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

  69:      On Error Resume Next

  70:      Select Case TypeName(objApp.ActiveWindow)

  71:          Case "Explorer"

  72:              Set GetCurrentItem = objApp.ActiveExplorer.Selection.Item(1)

  73:          Case "Inspector"

  74:              Set GetCurrentItem = objApp.ActiveInspector.CurrentItem

  75:          Case Else

  76:             

  77:      End Select

  78:       

  79:      Set objApp = Nothing

  80:  End Function

Copy code from above and paste it on notepad. Then save the file in .bas format. Make sure to create a category “@Office” in outlook before proceeding further, else you category will not have any color.

Now go to outlook and press Alt+F11. It will open the Visual Basic editor. Now right click on left pane and click on import.

 

Now browse the the above file and select and then click ok. Once the file is imported, go to tools  --> Macro. Then select the Macro you have created and then click on run. This will run the Macro first time.

 

How to add button for the added Macro

 

Right click on top of the outlook and click on Customize

 

 

Under categories select Macros and from right hand side select the Macro you have created. Now you have to drag and drop this Macro from the window below shown to the top of the Outlook. At the same time you can rename the Macro.

 

 

This will complete the task of creation of Macro for 1 action. You can follow above steps to create Macro and their respective button. You just need to change value from the above given script at line number 5, 16, 25, 57 and 60

After adding all buttons your outlook will look like this--

 

 

The post will continue…..