![]() |
If this is your first visit, be sure to check out the FAQ by clicking the link above. You may have to register before you can post: click the register link above to proceed. To start viewing messages, select the forum that you want to visit from the selection below. |
|
|
|
Thread Tools | Search this Thread | Display Modes |
#11
|
|||
|
|||
![]()
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 |
Ads |
#12
|
|||
|
|||
![]()
Hi Michael - I'm not sure what I am doing wrong - the dialog box to create a
new task only when all task body ie the - action 1 @calls - action 2 @computer are empty Here is the code ' 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 |
#13
|
|||
|
|||
![]()
Michael not sure why this is not working??
the box to create a new task should only come up when all the - and @ have been emptied out of the body of the task ==== 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 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 |
#14
|
|||
|
|||
![]()
Am Fri, 24 Mar 2006 00:35:22 -0800 schrieb fionamac:
Sorry, reading that is too much effort. For me, please delete all the line numbers and "sort" the code, i.e. a structure that can be read easily looks like this: If ... Then indent the code indent the code Else If ... Then indent the code Else indent the code End If End If In that way it´s easy to see what statements belong to what If or Else condition. After that you could add the line numbers again. -- Viele Gruesse / Best regards Michael Bauer - MVP Outlook -- www.vbOffice.net -- Michael not sure why this is not working?? the box to create a new task should only come up when all the - and @ have been emptied out of the body of the task ==== 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 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 |
#15
|
|||
|
|||
![]()
' Module : ThisOutlookSession
' Description: ' Procedures : Application_Startup() ' objTaskItems_ItemChange(ByVal pobjItem As Object) ' Modified : ' 11/13/03 GTDPolice code by Bill Kratz; ' 02/11/05 "Next Steps" to included handling of sequential actions by Xoff Poppe 2/11/05 ' For Next Steps to work first action needs to be in subject line of the task. ' Following actions need to be in the Body of task each in its own line and preceded by "- " (dash space) ' Below each Action is the context of the action ie @calls ' For each new project, I create the first task and add all the next actions in the notes/body ' of that same task. Once I mark complete the first task and when Running GTD Police with "Next Steps", if it is a ' project related task and has a follow-up task listed in the notes/body ' the macro creates the new task with the same project name and the next ' action from the notes/body. The other next actions stay in the ' notes/body field. ' If is a project related and no tasks are listed in the notes/body the ' standard pop-up appears asking if I want to create a new task related to the same project. ' The trigger for the "Next Steps" macro is a "- " lead ahead of each ' action, with one action per line. ' 03/24/06 "Next Steps Plus" is "Next Steps " modified to include that below each action is the context ie @calls if I need to make a phone call 'A task to trigger the "Next Steps" code would look like this: ' Project: Project Name ' Subject: First Task Action: @Context ' Notes/Body field looks like this ' - Second Task ' @Calls ' - Third Task ' @computer ' - Fourth Task ' @Errands '- Fifth Task '@Home '...etc ' -------------------------------------------------- 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 strBody As String Dim NewSubject As String Dim NewBody As String Dim PosCR As Integer 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") 75 strBody = pobjItem.Body 80 If Not pobjItem.UserProperties("Project") = "" Then 90 If pobjItem.Status = 2 Then 95 If Left(strBody, 1) = "-" Then 'dash can be replaced for any other constant traile 100 Set objNewTask = objApp.CreateItem(olTaskItem) 110 With objNewTask 120 objNewTask.UserProperties.Add("Project", olText) = strProject 'Item.UserProperties("Project") 130 objNewTask.UserProperties.Add("GettingThingsDone", olYesNo) = 1 133 If InStr(strBody, vbCrLf) Empty Then 135 PosCR = InStr(strBody, vbCrLf) 'looks for position of carriage return 140 objNewTask.Subject = Mid(strBody, 3, (PosCR - 3)) 'third position in Mid removes "- " 150 objNewTask.Body = Right(strBody, ((Len(strBody) - PosCR) - 1)) 155 Else 157 objNewTask.Subject = Right(strBody, ((Len(strBody) - 2))) 'number 2 removes "- " ' then I need the code to bring the @context into the "Action" of the new Task 160 End If 'objNewTask.Subject = "[" & Item.UserProperties("Project") & "]" 190 objNewTask.Display 200 End With 'Next Steps ends here 210 Else 220 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?") 230 If intAns = 6 Then 240 Set objNewTask = objApp.CreateItem(olTaskItem) 250 With objNewTask 260 objNewTask.UserProperties.Add("Project", olText) = strProject 'Item.UserProperties("Project") 270 objNewTask.UserProperties.Add("GettingThingsDone", olYesNo) = 1 280 'objNewTask.Subject = "[" & Item.UserProperties("Project") & "]" 285 objNewTask.Display 290 End With 300 End If 310 End If 320 End If 330 End If 340 End If 350 End If 360 Set objApp = Nothing 370 Set objNewTask = Nothing 380 Set objProperty = Nothing 390 Set pobjItem = Nothing 'TVCodeTools ErrorHandlerStart PROC_EXIT: 400 Exit Sub PROC_ERR: 500 Call LogError(Err.Number, Err.Description, "objTaskItems_ItemChange", Erl, "ThisOutlookSession") 510 Resume PROC_EXIT 'TVCodeTools ErrorHandlerEnd End Sub "Michael Bauer" wrote: Am Fri, 24 Mar 2006 00:35:22 -0800 schrieb fionamac: Sorry, reading that is too much effort. For me, please delete all the line numbers and "sort" the code, i.e. a structure that can be read easily looks like this: If ... Then indent the code indent the code Else If ... Then indent the code Else indent the code End If End If In that way it´s easy to see what statements belong to what If or Else condition. After that you could add the line numbers again. -- Viele Gruesse / Best regards Michael Bauer - MVP Outlook -- www.vbOffice.net -- Michael not sure why this is not working?? the box to create a new task should only come up when all the - and @ have been emptied out of the body of the task ==== 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 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 |
|
Thread Tools | Search this Thread |
Display Modes | |
|
|
![]() |
||||
Thread | Thread Starter | Forum | Replies | Last Post |
expression which is not collaction type error in vb.net | Sanjay | Outlook and VBA | 3 | February 24th 06 03:48 PM |