• If you are new to these Forums, please take a moment to register using the fields above.


No announcement yet.

In Need of GTD Police (clean)

  • Filter
  • Time
  • Show
Clear All
new posts

  • In Need of GTD Police (clean)

    Hello All,

    Went back to the Add-in Support site to get Bill Kratz GTD Police, it looks as though when they overhauled the forum software used, it may have altered the original code and maybe the entire message from Bill. There is a lot of garbage and text run-in at the end of the code line 210.

    So if anyone has a copy of the clean code and could post it, I would be thankful.

  • #2
    I need it to if anyone has it!


    • #3
      Google's cache of old GTD Police thread:

      Regards.....Bill Kratz


      • #4
        Thanks Bill, but when I tried to Google the old threads, I found it was not available because NetCentrics changed their forum software. So while it was listed, the link would bring up an error page. The link you provided dead ends also.

        The one you posted on NetCentrics worked great... thank you!
        Last edited by MsftMan; 09-02-2005, 09:54 AM.


        • #5
          GTD police (whkratz) with next steps (xoff) macro

          Ok - I think I found the clean - GTD police (whkratz) with next steps (xoff) which goes in thisoutlooksession - error handlers and enable police are in goggle cache - see post by whkatz a few posts above

          - try at your own risk (aka professional driver on closed course) watch for any lines which get word wrapped in this post - they usually show up in red in VBA

          ' 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)
          ' --------------------------------------------------
          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
          Exit Sub

          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

          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
          'Next Steps code starts here
          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 "- "
          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
          400 Exit Sub

          500 Call LogError(Err.Number, Err.Description, "objTaskItems_ItemChange", Erl, "ThisOutlookSession")
          510 Resume PROC_EXIT
          'TVCodeTools ErrorHandlerEnd

          End Sub


          • #6
            Originally this code worked fine and then I think I put google search bar in Outlook 2003 and things started to go pear shape.

            Whenever i open Outlook for the first time I get the vba debug window saying the following: Sub or Function Not Defined

            Refers to line 28:

            Call LogError

            tried to copy the code again but still the same issue.

            Anyone know of a work around?