Update of task time from journal entry

[David Parker]

Using Outlook 2003 I've got the below macro working in order to give myself
a "start work on task" option in the task window. What I'd like to do is
increment the "actual work" field on the task by the duration of the journal
entry once the journal entry has been saved and closed. Is there any way to
do this and could anyone offer me a pointer how? Or maybe someone else has
already done this.

Sub DaveStartWorkOnTask()
Dim objTask As Outlook.TaskItem
Dim objJi As Outlook.JournalItem
If Application.ActiveInspector.CurrentItem.Class = olTask Then
Set objTask = Application.ActiveInspector.CurrentItem
Set objJi = Application.CreateItem(olJournalItem)
With objJi
.Display
.Sensitivity = objTask.Sensitivity
.Type = "Task"
.Subject = objTask.Subject
.Attachments.Add objTask, olTask

' Copy categories and contacts
Dim objLink As Link
For Each objLink In objTask.Links
.Links.Add objLink.Item
Next objLink
.Categories = objTask.Categories

.Start = Now
.StartTimer
End With
End If
End Sub

 

[Michael Bauer]

Am Tue, 11 Oct 2005 13:36:06 +0100 schrieb David Parker:

David, you can declare the variable for the JournalEntry WithEvents in the
modul head instead of in the DaveStartWorkOnTask method. Doing so you´ll be
able to receive its Close event. In that event you can update the task and
the cleanup the JournalItem reference.

 

[David Parker]

Thanks! I've now been able to get a basic version working with a few small
issues using the new class module at the bottom....

- If the save feature is used in a journal entry, the time is saved but the
time for any subsequent saves is not added into the task

- If the journal entry is closed and Yes is answered on the "Do you want to
save changes?" dialog the time is not updated since Close is called before
Write

- If I put everything in the close event to get around the above problems it
gets updated even when the journal entry is closed without saving. Since
Close is fired before the confirmation I'm not sure what to do about this -
I could do with an event that is fired after this message box that tells me
whether the item is being saved and closed, or discarded.

Code...

Public WithEvents JournalEntry As Outlook.JournalItem
Public TaskEntry As Outlook.TaskItem
Public CollectionLink As Collection ' link to parent collection to remove
from when closed

Private Sub JournalEntry_Close(Cancel As Boolean)
If Not CollectionLink Is Nothing Then
CollectionLink.Remove JournalEntry.EntryID
Set CollectionLink = Nothing
End If
End Sub

Private Sub JournalEntry_Write(Cancel As Boolean)
If Not CollectionLink Is Nothing Then
TaskEntry.Mileage = TaskEntry.Mileage & "+" & JournalEntry.Duration
TaskEntry.ActualWork = TaskEntry.ActualWork + JournalEntry.Duration
CollectionLink.Remove JournalEntry.EntryID
Set CollectionLink = Nothing
End If
End Sub

 

[David Parker]

Just thought I'd share my progress...

Using the below everything seems to work reasonably well. It could be
improved by also being able to update tasks whose windows have been closed,
and also update tasks correctly when a journal entry is re-opened and the
time modified (I'm guessing I can do the former by storing the task ID and
doing some kind of search on it or something, no idea about the latter since
it won't have a TaskJournalEntry object automatically created).

But here's the code I've ended up with anyway....

----
Class module: TaskJournalEntry

Private EntryID As String

Private LastWroteDuration As Long
Private OriginalMileage As String ' original mileage field before this
entry modified it

Private Sub Class_Initialize()
OriginalMileage = "Unset"
End Sub

Public Sub InitAfterPropertiesSet()
' Call this after the JournalEntry, TaskEntry and CollectionLink have
been set
EntryID = JournalEntry.EntryID ' gets around problem of JournalEntry
not always being accessible in Close event
OriginalMileage = TaskEntry.Mileage
End Sub

Private Sub JournalEntry_Close(Cancel As Boolean)
If Not CollectionLink Is Nothing Then
' Has duration changed since save?
If JournalEntry.Duration <> LastWroteDuration Then
Cancel = (MsgBox("Sure to discard journal entry without updating
actual work field?", vbExclamation Or vbOKCancel Or vbDefaultButton2, "Close
without updating time worked?") = vbCancel)
End If

' Close going ahead, perform cleanup
If Not Cancel Then
CollectionLink.Remove EntryID
Set CollectionLink = Nothing
End If
End If
End Sub

Private Sub JournalEntry_Write(Cancel As Boolean)
If Not CollectionLink Is Nothing Then
If LastWroteDuration > 0 Then
' Remove previously added duration
Debug.Assert OriginalMileage <> "Unset"
TaskEntry.Mileage = OriginalMileage
TaskEntry.ActualWork = TaskEntry.ActualWork - LastWroteDuration
End If

If OriginalMileage = "Unset" Then OriginalMileage =
TaskEntry.Mileage
LastWroteDuration = JournalEntry.Duration
TaskEntry.Mileage = TaskEntry.Mileage & "+" & LastWroteDuration
TaskEntry.ActualWork = TaskEntry.ActualWork + LastWroteDuration
'CollectionLink.Remove JournalEntry.EntryID
'Set CollectionLink = Nothing
End If
End Sub

----
Module with macro to actually create the entry from a task

Private TaskJournalEntryCollection As New Collection

Sub DaveStartWorkOnTask()
Dim objTask As Outlook.TaskItem
Dim objJi As Outlook.JournalItem
If Application.ActiveInspector.CurrentItem.Class = olTask Then
Set objTask = Application.ActiveInspector.CurrentItem
Set objJi = Application.CreateItem(olJournalItem)
With objJi
' Display and set main properties, plus add task shortcut
.Display
.Type = "Task"
.Subject = objTask.Subject
.Importance = objTask.Importance
.Sensitivity = objTask.Sensitivity
.Companies = objTask.Companies
.Attachments.Add objTask, olTask

' Copy categories and contacts
Dim objLink As Link
For Each objLink In objTask.Links
.Links.Add objLink.Item
Next objLink
.Categories = objTask.Categories

' If a delegated task, ensure delegator is linked to
If objTask.Delegator <> "" Then
Dim objDelegator As ContactItem
Set objDelegator =
Application.Session.GetDefaultFolder(olFolderContacts).Items.Find("[FullName
]=" & objTask.Delegator)
If Not (objDelegator Is Nothing) Then .Links.Add
objDelegator
End If

' Set up plumbing for actual-work update
Dim objTJE As New TaskJournalEntry
Set objTJE.TaskEntry = objTask
Set objTJE.JournalEntry = objJi
TaskJournalEntryCollection.Add objTJE, objJi.EntryID
Set objTJE.CollectionLink = TaskJournalEntryCollection
objTJE.InitAfterPropertiesSet

' Start timing from now
.Start = Now
.StartTimer
End With
End If
End Sub

 

[Michael Bauer]

Am Wed, 12 Oct 2005 10:08:40 +0100 schrieb David Parker:

Not sure if you still have a question or if everything is fine now. The
order of events, if you´re closing an item that has been changed and
answering the save dialog with yes, is:

Journal_Close
"Do you want to save changes" = vbYes
Journal_Write
Inspector_Close


--
Viele Gruesse / Best regards
Michael Bauer - MVP Outlook

Just thought I'd share my progress...

Using the below everything seems to work reasonably well. It could be
improved by also being able to update tasks whose windows have been closed,
and also update tasks correctly when a journal entry is re-opened and the
time modified (I'm guessing I can do the former by storing the task ID and
doing some kind of search on it or something, no idea about the latter since
it won't have a TaskJournalEntry object automatically created).

But here's the code I've ended up with anyway....

----
Class module: TaskJournalEntry

Private EntryID As String

Private LastWroteDuration As Long
Private OriginalMileage As String ' original mileage field before this
entry modified it

Private Sub Class_Initialize()
OriginalMileage = "Unset"
End Sub

Public Sub InitAfterPropertiesSet()
' Call this after the JournalEntry, TaskEntry and CollectionLink have
been set
EntryID = JournalEntry.EntryID ' gets around problem of JournalEntry
not always being accessible in Close event
OriginalMileage = TaskEntry.Mileage
End Sub

Private Sub JournalEntry_Close(Cancel As Boolean)
If Not CollectionLink Is Nothing Then
' Has duration changed since save?
If JournalEntry.Duration <> LastWroteDuration Then
Cancel = (MsgBox("Sure to discard journal entry without updating
actual work field?", vbExclamation Or vbOKCancel Or vbDefaultButton2, "Close
without updating time worked?") = vbCancel)
End If

' Close going ahead, perform cleanup
If Not Cancel Then
CollectionLink.Remove EntryID
Set CollectionLink = Nothing
End If
End If
End Sub

Private Sub JournalEntry_Write(Cancel As Boolean)
If Not CollectionLink Is Nothing Then
If LastWroteDuration > 0 Then
' Remove previously added duration
Debug.Assert OriginalMileage <> "Unset"
TaskEntry.Mileage = OriginalMileage
TaskEntry.ActualWork = TaskEntry.ActualWork - LastWroteDuration
End If

If OriginalMileage = "Unset" Then OriginalMileage =
TaskEntry.Mileage
LastWroteDuration = JournalEntry.Duration
TaskEntry.Mileage = TaskEntry.Mileage & "+" & LastWroteDuration
TaskEntry.ActualWork = TaskEntry.ActualWork + LastWroteDuration
'CollectionLink.Remove JournalEntry.EntryID
'Set CollectionLink = Nothing
End If
End Sub

----
Module with macro to actually create the entry from a task

Private TaskJournalEntryCollection As New Collection

Sub DaveStartWorkOnTask()
Dim objTask As Outlook.TaskItem
Dim objJi As Outlook.JournalItem
If Application.ActiveInspector.CurrentItem.Class = olTask Then
Set objTask = Application.ActiveInspector.CurrentItem
Set objJi = Application.CreateItem(olJournalItem)
With objJi
' Display and set main properties, plus add task shortcut
.Display
.Type = "Task"
.Subject = objTask.Subject
.Importance = objTask.Importance
.Sensitivity = objTask.Sensitivity
.Companies = objTask.Companies
.Attachments.Add objTask, olTask

' Copy categories and contacts
Dim objLink As Link
For Each objLink In objTask.Links
.Links.Add objLink.Item
Next objLink
.Categories = objTask.Categories

' If a delegated task, ensure delegator is linked to
If objTask.Delegator <> "" Then
Dim objDelegator As ContactItem
Set objDelegator =
Application.Session.GetDefaultFolder(olFolderContacts).Items.Find("[FullName
]=" & objTask.Delegator)
If Not (objDelegator Is Nothing) Then .Links.Add
objDelegator
End If

' Set up plumbing for actual-work update
Dim objTJE As New TaskJournalEntry
Set objTJE.TaskEntry = objTask
Set objTJE.JournalEntry = objJi
TaskJournalEntryCollection.Add objTJE, objJi.EntryID
Set objTJE.CollectionLink = TaskJournalEntryCollection
objTJE.InitAfterPropertiesSet

' Start timing from now
.Start = Now
.StartTimer
End With
End If
End Sub