S
SimonColes
Guest
gunns256 said:
I'd be interested in using your code, gunns256. I'm also following William's projects-as-contacts approach.
Thanks,
Simon
You are using an out of date browser. It may not display this or other websites correctly.
You should upgrade or use an alternative browser.
You should upgrade or use an alternative browser.
Outlook Macro to handle consecutive tasks
- Thread starter xoff
- Start date
I'd be interested in using your code, gunns256. I'm also following William's projects-as-contacts approach.
Thanks,
Simon
U
Unregistered
Guest
Gunns256:
Please post that code. I am using Contacts as Projects too, and would love to see it.
Please post that code. I am using Contacts as Projects too, and would love to see it.
Projects as contacts code (thanks to whkratz, xoff)
Many assumptions:
Assumes that you don't mind waiting until I have time till I read this forum again.
Assumes Projects folder containing contact items. You may use the Project form posted by WHK years ago. Or you can just start with contacts.
Assumes all projects are named with bracket enclosures [MyProject] and cannot contain commas [My Project, which I will do next]. (The commas screw up some convention in Outlook's name routines.)
Assumes that some projects contain lists of NAs on lines with heading "- " notice space.
Assumes existence of toolbar "Advanced".
Assumes familiarity with VB editor. Assumes tolerance of imperfect code. (This is still a work in progress.)
Assumes tolerance by xoff, whkratz, of modifications of their publicly posted code.
I think that's all the assumptions.
Purpose: GTD police, NA list in body field of ProjectContacts will create new NA on project completion, toolbar with 3 menus for tasks: Projects, Defer, Context.
There may be some trouble with wordwrapping code copied from this forum.
Many assumptions:
Assumes that you don't mind waiting until I have time till I read this forum again.
Assumes Projects folder containing contact items. You may use the Project form posted by WHK years ago. Or you can just start with contacts.
Assumes all projects are named with bracket enclosures [MyProject] and cannot contain commas [My Project, which I will do next]. (The commas screw up some convention in Outlook's name routines.)
Assumes that some projects contain lists of NAs on lines with heading "- " notice space.
Assumes existence of toolbar "Advanced".
Assumes familiarity with VB editor. Assumes tolerance of imperfect code. (This is still a work in progress.)
Assumes tolerance by xoff, whkratz, of modifications of their publicly posted code.
I think that's all the assumptions.
Purpose: GTD police, NA list in body field of ProjectContacts will create new NA on project completion, toolbar with 3 menus for tasks: Projects, Defer, Context.
There may be some trouble with wordwrapping code copied from this forum.
Projects as contacts code (thanks to whkratz, xoff)
There are two sections of code to copy and paste: This section, to copy and paste into ThisOutlookSession, and another section, to c & p into a new module (mine is named Utilities).
' Module : ThisOutlookSession
' Description:
' Procedures : Application_Startup()
' objTaskItems_ItemChange(ByVal pobjItem As Object)
' Modified :
' 11/13/03 WHK
' Modified 4/16/2005 EFG
' --------------------------------------------------
Private WithEvents objTaskItems As Items
Private Sub Application_Quit()
Set objTaskItems = Nothing
End Sub
Private Sub Application_Startup()
On Error GoTo PROC_ERR
TestAddComboBoxToCommandBar 'adds 3 comboboxes to a commandbar named Advanced
'comboboxes are Projects, Defer, and Context
Set objTaskItems = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderTasks).Items
'yes, that's the taskitems folder
'all these various outlook variables
'give me a pain in the ass. I'm
'hardcoding the whole thing.
PROC_EXIT:
Exit Sub
PROC_ERR:
'removed errorlog
Resume PROC_EXIT
End Sub
Private Sub objTaskItems_ItemChange(ByVal pobjItem As Object)
On Error GoTo PROC_ERR
Dim objNewTask As TaskItem 'will be new N/A task
Dim intAns As Integer 'input from msgbox
Dim objProj As ContactItem 'found in folder "Projects"
Dim strSubject As String 'will be subject of next action task
Dim strProject As String 'name of project
Dim strBody As String 'body field of found project, may contain formatted list of NAs
Dim posCR As Integer 'carriagereturn position, delimits NAs in body field of found project
If pobjItem.Links.Count = 0 Then Exit Sub 'no links, no project, nothing to do
If pobjItem.Links.Count = 1 And InStr(1, pobjItem.Links.Item(1).Name, "[") = 1 Then
'project names must be delimited with brackets [ProjectName]
'limited now to only project contacts, routine will fail if there are other contacts which are not projects
'project contacts are linked
strSubject = pobjItem.Subject 'allows use in msgbox with completion announcement
strProject = pobjItem.Links.Item(1).Name
'open a project's body field with list of NAs
Set objProj = Application.GetNamespace("mapi").Folders.Item(1).Folders("Projects").Items.Item(strProject)
strBody = objProj.Body
If pobjItem.Status = 2 Then 'that would be completed
intAns = MsgBox("You have completed a Project-related Task." _
& vbCrLf & "Task: " & strSubject & vbCrLf & "Project: " _
& strProject & vbCrLf & "Do you want to create a new Next Action for the Project?", _
36, "Next Action?")
End If
If intAns = 6 Then 'Not testing for anything else
Set objNewTask = pobjItem.Copy 'why not? It's already linked to the project, and probably in the right context
If Left(strBody, 1) = "-" Then '- dash/space will signify
'the beginning of a next action in the project body field
If InStr(strBody, vbCrLf) Empty Then
posCR = InStr(strBody, vbCrLf)
strSubject = Mid(strBody, 3, (posCR - 3))
strBody = Right(strBody, Len(strBody) - posCR - 1)
strBody = strBody & vbCrLf & "x " & strSubject
objProj.Body = strBody 'takes first line of body field, uses it, moves it to end with x
objProj.Save
Else
posCR = Len(strBody) 'just a 1 liner, cut, use, and replace
strSubject = Mid(strBody, 3, (posCR - 2))
strBody = "x " & strSubject
objProj.Body = strBody 'takes first line of body field, uses it, moves it to end with x
objProj.Save
End If
Else
strSubject = InputBox("Taskname?") 'no NAs in body field
End If
objNewTask.Subject = strSubject
objNewTask.Status = olTaskNotStarted
objNewTask.Display
End If
End If
Set objProj = Nothing
Set objNewTask = Nothing
Set pobjItem = Nothing
PROC_EXIT:
Exit Sub
PROC_ERR:
Resume PROC_EXIT
End Sub
There are two sections of code to copy and paste: This section, to copy and paste into ThisOutlookSession, and another section, to c & p into a new module (mine is named Utilities).
' Module : ThisOutlookSession
' Description:
' Procedures : Application_Startup()
' objTaskItems_ItemChange(ByVal pobjItem As Object)
' Modified :
' 11/13/03 WHK
' Modified 4/16/2005 EFG
' --------------------------------------------------
Private WithEvents objTaskItems As Items
Private Sub Application_Quit()
Set objTaskItems = Nothing
End Sub
Private Sub Application_Startup()
On Error GoTo PROC_ERR
TestAddComboBoxToCommandBar 'adds 3 comboboxes to a commandbar named Advanced
'comboboxes are Projects, Defer, and Context
Set objTaskItems = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderTasks).Items
'yes, that's the taskitems folder
'all these various outlook variables
'give me a pain in the ass. I'm
'hardcoding the whole thing.
PROC_EXIT:
Exit Sub
PROC_ERR:
'removed errorlog
Resume PROC_EXIT
End Sub
Private Sub objTaskItems_ItemChange(ByVal pobjItem As Object)
On Error GoTo PROC_ERR
Dim objNewTask As TaskItem 'will be new N/A task
Dim intAns As Integer 'input from msgbox
Dim objProj As ContactItem 'found in folder "Projects"
Dim strSubject As String 'will be subject of next action task
Dim strProject As String 'name of project
Dim strBody As String 'body field of found project, may contain formatted list of NAs
Dim posCR As Integer 'carriagereturn position, delimits NAs in body field of found project
If pobjItem.Links.Count = 0 Then Exit Sub 'no links, no project, nothing to do
If pobjItem.Links.Count = 1 And InStr(1, pobjItem.Links.Item(1).Name, "[") = 1 Then
'project names must be delimited with brackets [ProjectName]
'limited now to only project contacts, routine will fail if there are other contacts which are not projects
'project contacts are linked
strSubject = pobjItem.Subject 'allows use in msgbox with completion announcement
strProject = pobjItem.Links.Item(1).Name
'open a project's body field with list of NAs
Set objProj = Application.GetNamespace("mapi").Folders.Item(1).Folders("Projects").Items.Item(strProject)
strBody = objProj.Body
If pobjItem.Status = 2 Then 'that would be completed
intAns = MsgBox("You have completed a Project-related Task." _
& vbCrLf & "Task: " & strSubject & vbCrLf & "Project: " _
& strProject & vbCrLf & "Do you want to create a new Next Action for the Project?", _
36, "Next Action?")
End If
If intAns = 6 Then 'Not testing for anything else
Set objNewTask = pobjItem.Copy 'why not? It's already linked to the project, and probably in the right context
If Left(strBody, 1) = "-" Then '- dash/space will signify
'the beginning of a next action in the project body field
If InStr(strBody, vbCrLf) Empty Then
posCR = InStr(strBody, vbCrLf)
strSubject = Mid(strBody, 3, (posCR - 3))
strBody = Right(strBody, Len(strBody) - posCR - 1)
strBody = strBody & vbCrLf & "x " & strSubject
objProj.Body = strBody 'takes first line of body field, uses it, moves it to end with x
objProj.Save
Else
posCR = Len(strBody) 'just a 1 liner, cut, use, and replace
strSubject = Mid(strBody, 3, (posCR - 2))
strBody = "x " & strSubject
objProj.Body = strBody 'takes first line of body field, uses it, moves it to end with x
objProj.Save
End If
Else
strSubject = InputBox("Taskname?") 'no NAs in body field
End If
objNewTask.Subject = strSubject
objNewTask.Status = olTaskNotStarted
objNewTask.Display
End If
End If
Set objProj = Nothing
Set objNewTask = Nothing
Set pobjItem = Nothing
PROC_EXIT:
Exit Sub
PROC_ERR:
Resume PROC_EXIT
End Sub
Projects as contacts code (thanks to whkratz, xoff)
Create new module, (mine is Utilities). Copy and paste:
Sub UpdateContext(objSel As Selection)
Dim objItem As Object
Dim mycategory As String
mycategory = Application.ActiveExplorer.CommandBars.Item("Advanced").Controls.Item("Context").Text
'MsgBox (mycategory)
Application.ActiveExplorer.CommandBars.Item("Advanced").Controls.Item("Context").Text = "Context"
For Each objItem In objSel
If objItem.Class = olTask Then
objItem.Categories = ""
objItem.Categories = mycategory
objItem.Save
Else
MsgBox (objItem.Class)
End If
Next
Set objItem = Nothing
End Sub
Sub UpdateDefer(objSel As Selection)
Dim objItem As Object
Dim strdeferdate As String
Dim mydate As Date
strdeferdate = Application.ActiveExplorer.CommandBars.Item("Advanced").Controls.Item("Defer").Text
Application.ActiveExplorer.CommandBars.Item("Advanced").Controls.Item("Defer").Text = "Defer"
'MsgBox (strdeferdate)
For Each objItem In objSel
If objItem.Class = olTask Then
If strdeferdate = "None" Then
objItem.DueDate = #1/1/4501# 'esoterica. look it up.
Else
mydate = objItem.DueDate
'these are good for me because I'm a teacher
If strdeferdate = "1 week" Then mydate = DateAdd("ww", 1, mydate)
If strdeferdate = "1 month" Then mydate = DateAdd("m", 1, mydate)
If strdeferdate = "End June" Then mydate = DateValue("6/25")
If strdeferdate = "End August" Then mydate = DateValue("8/25")
If mydate < Date Then mydate = mydate + 365
objItem.DueDate = mydate
End If
objItem.Save
Else
MsgBox (objItem.Class)
End If
Next
Set objItem = Nothing
End Sub
Sub UpdateProject(objSel As Selection)
Dim objItem As Object
Set mynamespace = Application.GetNamespace("MAPI")
Set myfolders = mynamespace.Folders
Set myfolder = myfolders.Item(1).Folders.Item("Projects")
strprojname = Application.ActiveExplorer.CommandBars.Item("Advanced").Controls.Item("Projects").Text
Application.ActiveExplorer.CommandBars.Item("Advanced").Controls.Item("Projects").Text = "Projects"
'MsgBox (strprojname)
If strprojname = "" Then
Exit Sub
End If
Set mycontact = myfolder.Items(strprojname)
For Each objItem In objSel
'If objItem.Class = olTask Then
objItem.Links.Add mycontact
objItem.Save
'End If
Next
Set objItem = Nothing
End Sub
Private Function SelectionAction()
Dim objSelection As Selection
Dim blnDoIt As Boolean
Dim intMaxItems As Integer
Dim intOKToExceedMax As Integer
Dim strMsg As String
intMaxItems = 5
Set objSelection = Application.ActiveExplorer.Selection
Select Case objSelection.Count
Case 0
strMsg = "No items were selected"
MsgBox strMsg, , "No selection"
blnDoIt = False
Case Is > intMaxItems
strMsg = "You selected " & _
objSelection.Count & " items. " & _
"Do you really want to process " & _
"that large a selection?"
intOKToExceedMax = MsgBox( _
Prompt:=strMsg, _
Buttons:=vbYesNo + vbDefaultButton2, _
Title:="Selection exceeds maximum")
If intOKToExceedMax = vbYes Then
blnDoIt = True
Else
blnDoIt = False
End If
Case Else
blnDoIt = True
End Select
If blnDoIt = True Then
If Application.ActiveExplorer.CommandBars.Item("Advanced").Controls.Item("Projects").Text "Projects" Then
Call UpdateProject(objSelection)
End If
If Application.ActiveExplorer.CommandBars.Item("Advanced").Controls.Item("Defer").Text "Defer" Then
Call UpdateDefer(objSelection)
End If
If Application.ActiveExplorer.CommandBars.Item("Advanced").Controls.Item("Context").Text "Context" Then
Call UpdateContext(objSelection)
End If
End If
Set objSelection = Nothing
'Set objApp = Nothing
End Function
Private Function AddComboBoxToCommandBar(ByVal strCommandBarName As String, _
ByVal strComboBoxCaption As String, _
ByRef strChoices() As String) As Boolean
' Purpose: Adds a combo box to a command bar.
' Accepts:
' strCommandBarName: The name of the command bar to add the combo box.
' strChoices(): An array of combo box choices.
' Returns: True if the combo box was successfully added to the command bar.
Dim objCommandBarControl As Office.CommandBarControl
Dim objCommandBarComboBox As Office.CommandBarComboBox
Dim varChoice As Variant
On Error GoTo AddComboBoxToCommandBar_Err
Application.ActiveExplorer.CommandBars.Item(strCommandBarName).Visible = True
' Delete any previously-added instances of this combo box.
' Replace the next line of code with:
For Each objCommandBarControl In _
Application.ActiveExplorer.CommandBars.Item(strCommandBarName).Controls
_
'
Create new module, (mine is Utilities). Copy and paste:
Sub UpdateContext(objSel As Selection)
Dim objItem As Object
Dim mycategory As String
mycategory = Application.ActiveExplorer.CommandBars.Item("Advanced").Controls.Item("Context").Text
'MsgBox (mycategory)
Application.ActiveExplorer.CommandBars.Item("Advanced").Controls.Item("Context").Text = "Context"
For Each objItem In objSel
If objItem.Class = olTask Then
objItem.Categories = ""
objItem.Categories = mycategory
objItem.Save
Else
MsgBox (objItem.Class)
End If
Next
Set objItem = Nothing
End Sub
Sub UpdateDefer(objSel As Selection)
Dim objItem As Object
Dim strdeferdate As String
Dim mydate As Date
strdeferdate = Application.ActiveExplorer.CommandBars.Item("Advanced").Controls.Item("Defer").Text
Application.ActiveExplorer.CommandBars.Item("Advanced").Controls.Item("Defer").Text = "Defer"
'MsgBox (strdeferdate)
For Each objItem In objSel
If objItem.Class = olTask Then
If strdeferdate = "None" Then
objItem.DueDate = #1/1/4501# 'esoterica. look it up.
Else
mydate = objItem.DueDate
'these are good for me because I'm a teacher
If strdeferdate = "1 week" Then mydate = DateAdd("ww", 1, mydate)
If strdeferdate = "1 month" Then mydate = DateAdd("m", 1, mydate)
If strdeferdate = "End June" Then mydate = DateValue("6/25")
If strdeferdate = "End August" Then mydate = DateValue("8/25")
If mydate < Date Then mydate = mydate + 365
objItem.DueDate = mydate
End If
objItem.Save
Else
MsgBox (objItem.Class)
End If
Next
Set objItem = Nothing
End Sub
Sub UpdateProject(objSel As Selection)
Dim objItem As Object
Set mynamespace = Application.GetNamespace("MAPI")
Set myfolders = mynamespace.Folders
Set myfolder = myfolders.Item(1).Folders.Item("Projects")
strprojname = Application.ActiveExplorer.CommandBars.Item("Advanced").Controls.Item("Projects").Text
Application.ActiveExplorer.CommandBars.Item("Advanced").Controls.Item("Projects").Text = "Projects"
'MsgBox (strprojname)
If strprojname = "" Then
Exit Sub
End If
Set mycontact = myfolder.Items(strprojname)
For Each objItem In objSel
'If objItem.Class = olTask Then
objItem.Links.Add mycontact
objItem.Save
'End If
Next
Set objItem = Nothing
End Sub
Private Function SelectionAction()
Dim objSelection As Selection
Dim blnDoIt As Boolean
Dim intMaxItems As Integer
Dim intOKToExceedMax As Integer
Dim strMsg As String
intMaxItems = 5
Set objSelection = Application.ActiveExplorer.Selection
Select Case objSelection.Count
Case 0
strMsg = "No items were selected"
MsgBox strMsg, , "No selection"
blnDoIt = False
Case Is > intMaxItems
strMsg = "You selected " & _
objSelection.Count & " items. " & _
"Do you really want to process " & _
"that large a selection?"
intOKToExceedMax = MsgBox( _
Prompt:=strMsg, _
Buttons:=vbYesNo + vbDefaultButton2, _
Title:="Selection exceeds maximum")
If intOKToExceedMax = vbYes Then
blnDoIt = True
Else
blnDoIt = False
End If
Case Else
blnDoIt = True
End Select
If blnDoIt = True Then
If Application.ActiveExplorer.CommandBars.Item("Advanced").Controls.Item("Projects").Text "Projects" Then
Call UpdateProject(objSelection)
End If
If Application.ActiveExplorer.CommandBars.Item("Advanced").Controls.Item("Defer").Text "Defer" Then
Call UpdateDefer(objSelection)
End If
If Application.ActiveExplorer.CommandBars.Item("Advanced").Controls.Item("Context").Text "Context" Then
Call UpdateContext(objSelection)
End If
End If
Set objSelection = Nothing
'Set objApp = Nothing
End Function
Private Function AddComboBoxToCommandBar(ByVal strCommandBarName As String, _
ByVal strComboBoxCaption As String, _
ByRef strChoices() As String) As Boolean
' Purpose: Adds a combo box to a command bar.
' Accepts:
' strCommandBarName: The name of the command bar to add the combo box.
' strChoices(): An array of combo box choices.
' Returns: True if the combo box was successfully added to the command bar.
Dim objCommandBarControl As Office.CommandBarControl
Dim objCommandBarComboBox As Office.CommandBarComboBox
Dim varChoice As Variant
On Error GoTo AddComboBoxToCommandBar_Err
Application.ActiveExplorer.CommandBars.Item(strCommandBarName).Visible = True
' Delete any previously-added instances of this combo box.
' Replace the next line of code with:
For Each objCommandBarControl In _
Application.ActiveExplorer.CommandBars.Item(strCommandBarName).Controls
_
'
Please post modified code
Yes, post your code, I'm collecting the various flavors of macros and will post a list when it's as complete as it will get.
--jf
Yes, post your code, I'm collecting the various flavors of macros and will post a list when it's as complete as it will get.
--jf
professor said:Hi, I have done a bit more fiddling, and now have amended the GTD Police Macro (already amended as described in this thread), so that all automatically created items are saved as messages in the InBox, instead of as Tasks, so that the user can then make the determination of what to do with them (Action, Delegate, Defer, Delete, Snooze).
In the event that there is no automatically defined task (using the "- next task" convention), the macro now creates a blank message addressed to the user, so that the newly filled in task info again becomes a message in the InBox for appropriate treatment.
In short, I think that this slight change makes the entire GTD/Outlook process consistent, ie *everything* comes in via your InBox.
If anyone's interested, they are free to have my hacked code.
Thanks,
Lee.
B
benjy_green
Guest
Broken Links
These links no longer work - Where can I access this code?
Does it work when using the Taskline form?
Thanks
Ben
xoff said:The link is http://gtdsupport.netcentrics.com/forum/topic.asp?TOPIC_ID=514
I suggest using the link as you will need to replace a portion of GTD Police posted at:
http://gtdsupport.netcentrics.com/forum/topic.asp?TOPIC_ID=253
Good luck
Xoff
These links no longer work - Where can I access this code?
Does it work when using the Taskline form?
Thanks
Ben
F
fionamac
Guest
adding next @actions to the next consecutive task
Hi all
Have been using modified GTD police code which I love (thx to messrs Kratz and Xoff!). As an incentive to do the weekly review, I add in all the @ actions beside the next consecutive tasks like those listed below during the review (so I really only have to think once a week). For example consecutive actions in the body of the task might be:
- Ring Jane for luke's email address @calls
- Email Luke about a meeting @computer
- Create agenda for meeting with luke @anywhere
...
but then during the week when I complete the task prior to 'Ring Jane..." the next task has '- Ring Jane for luke's email address @calls' in the subject line and I cut and paste @calls into Actions.
I have been trying to get the '@ calls' to go straight into the Action field - by trying to understand the code of the VBA masters - without success - Any ideas people??? I'll persevere and share the code if I crack it!!!
Regards, Fiona
Hi all
Have been using modified GTD police code which I love (thx to messrs Kratz and Xoff!). As an incentive to do the weekly review, I add in all the @ actions beside the next consecutive tasks like those listed below during the review (so I really only have to think once a week). For example consecutive actions in the body of the task might be:
- Ring Jane for luke's email address @calls
- Email Luke about a meeting @computer
- Create agenda for meeting with luke @anywhere
...
but then during the week when I complete the task prior to 'Ring Jane..." the next task has '- Ring Jane for luke's email address @calls' in the subject line and I cut and paste @calls into Actions.
I have been trying to get the '@ calls' to go straight into the Action field - by trying to understand the code of the VBA masters - without success - Any ideas people??? I'll persevere and share the code if I crack it!!!
Regards, Fiona