Hi Michael
I'm not sure what I am doing wrong - here is the code - the dialog box to
create another action should only open if there are no more actions included
in the body of the task
- action 1
@calls
- action 2
@computer
' Module : ThisOutlookSession
' Description:
' Procedures : Application_Startup()
' objTaskItems_ItemChange(ByVal pobjItem As Object)
' Modified :
' 11/13/03 WHK
'
' --------------------------------------------------
Private WithEvents objTaskItems As Items
Private Sub Application_Startup()
'TVCodeTools ErrorEnablerStart
On Error GoTo PROC_ERR
'TVCodeTools ErrorEnablerEnd
Dim objNS As NameSpace
Set objNS = Application.GetNamespace("MAPI")
Set objTaskItems = objNS.GetDefaultFolder(olFolderTasks).Items
'TVCodeTools ErrorHandlerStart
PROC_EXIT:
Exit Sub
PROC_ERR:
Call LogError(Err.Number, Err.Description, "Application_Startup", Erl,
"ThisOutlookSession")
Resume PROC_EXIT
'TVCodeTools ErrorHandlerEnd
End Sub
Private Sub objTaskItems_ItemChange(ByVal pobjItem As Object)
'TVCodeTools ErrorEnablerStart
10 On Error GoTo PROC_ERR
'TVCodeTools ErrorEnablerEnd
Dim objApp As Outlook.Application
Dim objNewTask As TaskItem
Dim intAns As Integer
Dim strSubject As String
Dim strProject As String
Dim objProperty As UserProperty
Dim posAnf As Long
Dim posEnd As Long
Dim NextSubject As String
Dim NextAction As String
Dim NextBody As String
20 Set objApp = CreateObject("Outlook.Application")
30 If GetSetting(appname:="GTDPolice", section:="Settings",
key:="Enable", Default:=0) = 1 Then
' Start NetCentrics Addin code
40 Set objProperty = pobjItem.UserProperties.Find("Project")
50 If Not objProperty Is Nothing Then
60 strSubject = pobjItem.Subject
70 strProject = pobjItem.UserProperties("Project")
80 If Not pobjItem.UserProperties("Project") = "" Then
90 If pobjItem.Status = 2 Then
'Start Bauer code
100 posAnf = InStr(pobjItem.Body, "- ")
110 If posAnf Then
120 posAnf = posAnf + 2
' look if it´s the last row
130 posEnd = InStr(posAnf, pobjItem, vbCrLf)
140 If posEnd Then
150 NextSubject = Mid(pobjItem.Body, posAnf, posEnd - posAnf)
' If the next row starts with an @ then it belongs to the former row
160 posAnf = posEnd + 2
170 If Mid(pobjItem.Body, posAnf, 1) = "@" Then
' Find the row´s end and the next action
180 posAnf = posAnf + 1
190 posEnd = InStr(posAnf, pobjItem.Body, vbCrLf)
200 If posEnd Then
210 NextAction = Mid(pobjItem.Body, posAnf, posEnd - posAnf)
220 Else
230 NextAction = Mid(pobjItem.Body, posAnf)
240 End If
250 End If
260 Else
270 NextSubject = Mid(pobjItem.Body, posAnf)
280 End If
' Get the body without the first two lines (maybe for the next task)
290 If posEnd Then
300 NextBody = Mid(pobjItem.Body, posEnd + 2)
330 Set objProperty = objNewTask.UserProperties.Add("Action", olText)
340 objProperty.Value = NextAction
350 objNewTask.Subject = NextSubject
360 objProperty = objNewTask.Body = NextBody
370 NewTask.Categories = GetCurrentItem.Categories
380 Else
390 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?")
400 If intAns = 6 Then
410 Set objNewTask = objApp.CreateItem(olTaskItem)
420 With objNewTask
430 objNewTask.UserProperties.Add("Project",
olText) = strProject 'Item.UserProperties("Project")
440
objNewTask.UserProperties.Add("GettingThingsDone", olYesNo) = 1
'objNewTask.Subject = "[" &
Item.UserProperties("Project") & "]"
' look for the next subject
450 objNewTask.Display
460
490
500
502
507
510
520 Set objApp = Nothing
530 Set objNewTask = Nothing
540 Set objProperty = Nothing
550 Set pobjItem = Nothing
'TVCodeTools ErrorHandlerStart
PROC_EXIT:
560 Exit Sub
PROC_ERR:
570 Call LogError(Err.Number, Err.Description,
"objTaskItems_ItemChange", Erl, "ThisOutlookSession")
580 Resume PROC_EXIT
'TVCodeTools ErrorHandlerEnd
End With
End If
End If
End If
End If
End If
End If
End If
End Sub
"Michael Bauer" wrote:
Am Thu, 23 Mar 2006 05:09:30 -0800 schrieb fionamac:
That´s no dumb question.
You can write this:
Set objProperty=objNewTask.UserProperties.Add("Action" , olText)
objProperty.Value=NextAction
--
Viele Gruesse / Best regards
Michael Bauer - MVP Outlook
-- www.vbOffice.net --
I'm just having problems 'setting the object'
I'm trying to set the userdefined field "action" with your calculated
"NextAction" but I keep getting an object error - sorry to ask a dumb
question
Set objNewTask.UserProperties.Add("Action", olText) = NextAction
'Item.UserProperties("Action")
"Michael Bauer" wrote:
Am Wed, 22 Mar 2006 19:31:28 -0800 schrieb fionamac:
The sample is an extension to your existing code. It only extracts the
mentioned values. You would like to write that values into
objNewTask.Subject and objNewTask.Body and its UserProperties called
"Next
action" yourself, please.
As for the problems with opening the VBA project: Please delete line 20
and
the Dim objApp... line. Then replace all remaining objApp by Application.
--
Viele Gruesse / Best regards
Michael Bauer - MVP Outlook
-- www.vbOffice.net --
so just to confirm ... I can now take the next "-" as well as the "@" up
into
the new task and when I tick that task complete - the macro will open a
new
task with the "-" as well as the "@" in the correct spots?
"Michael Bauer" wrote:
Am Tue, 21 Mar 2006 15:33:29 -0800 schrieb fionamac:
This sample gets the first lines, starting with a hyphen and ampersand,
and
it extracts all the body that follows after these lines. The values are
being stored in the variables NextSubject, NextAction and NextBody.
You can write these variables now into the object´s properties.
Insert this between line 10 and 20:
Dim posAnf as Long
Dim posEnd as Long
Dim NextSubject as String
Dim NextAction as String
Dim NextBody as String
And this between 150 and 160:
' look for the next subject
posAnf=Instr(pobjItem.Body, "- ")
If posAnf Then
posAnf=posAnf+2
' look if it´s the last row
posEnd=Instr(posAnf, pobjItem, vbCRLF)
If posEnd Then
NextSubject = Mid(pobjItem.Body, posAnf, posEnd-posAnf)
' If the next row starts with an @ then it belongs to the former row
posAnf=posEnd+2
If mid(pobjItem.Body, posAnf, 1) = "@" Then
' Find the row´s end and the next action
posAnf=posAnf+1
posEnd=Instr(posAnf, pobjItem.Body, vbCRLF)
If posEnd Then
NextAction=Mid(pobjItem.Body, posAnf, posEnd-posAnf)
Else
NextAction=Mid(pobjItem.Body, posAnf)
Endif
Endif
Else
NextSubject=Mid(pobjItem.Body, posAnf)
Endif
' Get the body without the first two lines (maybe for the next task)
If posEnd Then
NextBody=Mid(pobjItem.Body, posEnd+2)
Endif
Endif
--
Viele Gruesse / Best regards
Michael Bauer - MVP Outlook
-- www.vbOffice.net --
I'm very new to this but I have found a fabulous macro - for managing
my
tasks - with user defined fields of "project" and 'next action'. I
would
like
some guidance to add a function and I was wondering if you could
please
tell
me what expression to use?
Basically in the body of a task - with a user defined field called
'Project'
The trigger for the "Next Steps" macro is a "- " lead ahead of each
action, with one action per line.
A task to trigger the "Next Steps" code would look like this:
Project: project name
Subject: First Task
Notes/Body field looks like this
- Second Task
- Third Task
- Fourth Task
- Fifth Task
...etc
so by completing the task with the ' Subject: First Task' then action
2
leaves the task body and gets put into the subject field.
For me I sort by 'action' so all the @calls are together when I am at
a
phone etc
to do this I include a context under each next action
- call Jane for Luke's email
@calls
- email Luke to set up a time to meet
@computer
- draft up notes for the meeting
@computer
...etc
when the next "-" task moves up from body to subject how do I move the
"@"
Action below it move to the the user defined 'Action' Field and move
the
next
"-" up to the first line of the task body???
here is the macro
' Module : ThisOutlookSession
' Description:
' Procedures : Application_Startup()
' objTaskItems_ItemChange(ByVal pobjItem As Object)
' Modified :
' 11/13/03 WHK
'
' --------------------------------------------------
Private WithEvents objTaskItems As Items
Private Sub Application_Startup()
'TVCodeTools ErrorEnablerStart
On Error GoTo PROC_ERR
'TVCodeTools ErrorEnablerEnd
Dim objNS As NameSpace
Set objNS = Application.GetNamespace("MAPI")
Set objTaskItems = objNS.GetDefaultFolder(olFolderTasks).Items
'TVCodeTools ErrorHandlerStart
PROC_EXIT:
Exit Sub
PROC_ERR:
Call LogError(Err.Number, Err.Description, "Application_Startup",
Erl,
"ThisOutlookSession")
Resume PROC_EXIT
'TVCodeTools ErrorHandlerEnd
End Sub
Private Sub objTaskItems_ItemChange(ByVal pobjItem As Object)
'TVCodeTools ErrorEnablerStart
10 On Error GoTo PROC_ERR
'TVCodeTools ErrorEnablerEnd
Dim objApp As Outlook.Application
Dim objNewTask As TaskItem
Dim intAns As Integer
Dim strSubject As String
Dim strProject As String
Dim objProperty As UserProperty
20 Set objApp = CreateObject("Outlook.Application")
30 If GetSetting(appname:="GTDPolice", section:="Settings",
key:="Enable", Default:=0) = 1 Then
' Start NetCentrics Addin code
40 Set objProperty = pobjItem.UserProperties.Find("Project")
50 If Not objProperty Is Nothing Then
60 strSubject = pobjItem.Subject
70 strProject = pobjItem.UserProperties("Project")
80 If Not pobjItem.UserProperties("Project") = "" Then
90 If pobjItem.Status = 2 Then
100 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?")
110 If intAns = 6 Then
120 Set objNewTask =
objApp.CreateItem(olTaskItem)
130 With objNewTask
140
objNewTask.UserProperties.Add("Project",
olText) = strProject 'Item.UserProperties("Project")
150
objNewTask.UserProperties.Add("GettingThingsDone", olYesNo) = 1
'objNewTask.Subject = "[" &
Item.UserProperties("Project") & "]"
160 objNewTask.Display
170 End With
180 End If
190 End If
200 End If
210 End If
220 End If
230 Set objApp = Nothing
240 Set objNewTask = Nothing
250 Set objProperty = Nothing
260 Set pobjItem = Nothing
'TVCodeTools ErrorHandlerStart
PROC_EXIT:
270 Exit Sub
PROC_ERR:
280 Call LogError(Err.Number, Err.Description,
"objTaskItems_ItemChange", Erl, "ThisOutlookSession")
290 Resume PROC_EXIT
'TVCodeTools ErrorHandlerEnd
End Sub