Best method to post actual hours to tasks

[LarryPritchard]

I have a project that I am tracking with over 50 individual sub-projects. I
have some VBA code that extracts from a Time Reporting SQL database and then
posts any hours from that week to the correct sub-project.

Here is the function that posts the updates to the actual hours:

'===============================================
'= Sub Step1_UpdateActualWork(strErrors)
'= Description: This sub will apply the programmer submitted hours
'===============================================
Sub Step1_UpdateActualWork(ByRef strErrors)
Dim strFunctionSub
Dim objConn
Dim objRS
Dim tskTask
Dim strTaskISRNbr
Dim strSQL
Dim strStatus
Dim strEndDate
Dim strStartDate
Dim lngTaskUID
Dim strResourceName
Dim lngResourceUID
Dim strTaskID
Dim strResourceID
Dim lngAssignmentUID
Dim strWorkEntryDate
Dim strWork

On Error GoTo ErrorHandler
strFunctionSub = "Step1_UpdateActualWork"

'Create local objects
Set objConn = CreateObject("ADODB.Connection")
Set objRS = CreateObject("ADODB.RecordSet")

'Open the connection object
objConn.Open g_strConnectInfo

'Loop thru all the Tasks so we can calculate the total hours worked.
For Each tskTask In ActiveProject.Tasks
'We only want to calculate on the tasks that
'have this Text10 Value (ISR Nbr)
strTaskISRNbr = tskTask.Text10

If strTaskISRNbr <> "" Then
'We don't want to update the project if the Flag1 (Complete)
'is set to Yes.
If tskTask.Flag1 = False Then
'Get the project info
strSQL = "SELECT PTR.Project_No, PTR.Project_Name,
PTR.Entry_Date, PTR.Close_Dt, PTR.Project_Status, P.Change_ID, Sum(P.Hours)
AS SumOfHours, P.Entry_Date As TimeEntryDate " & _
"FROM dbo.Project_Time P INNER JOIN dbo.PTR_Master PTR ON
P.Project_No = PTR.Project_No " & _
"WHERE PTR.Project_No = '" & strTaskISRNbr & "' And
P.Change_ID Is Not Null And P.Entry_Date > '" & g_strSearchBeginDate & "' And
P.Entry_Date <= '" & g_strSearchEndDate & "' And P.Hours > 0 " & _
"GROUP BY PTR.Project_No, PTR.Project_Name, PTR.Entry_Date,
PTR.Close_Dt, PTR.Project_Status, P.Change_ID, P.Entry_Date " & _
"ORDER BY PTR.Project_No, P.Entry_Date;"

'Make the SQL call
Call objRS.Open(strSQL, objConn)

If Not objRS.EOF Then
'First use the TaskUID for lookups
lngTaskUID = tskTask.UniqueID
strTaskID = CLng(tskTask.ID)

'Status will be OPEN or COMPLETED or CANCELLED
strStatus = objRS("Project_Status")

'Set the Begin/End Dates
strStartDate = CStr(objRS("Entry_Date"))

If UCase(strStatus) = "OPEN" Then
'Set the End Date = NA
strEndDate = "NA"
Else
strEndDate = CStr(objRS("Close_Dt"))
End If

'Loop thru multiple resources that could of worked
'on this Task
Do While Not objRS.EOF
'What resource are we looking for?
strResourceName = UCase(objRS("Change_ID"))

'Get the TaskUID or 0 if it doesn't exist
lngResourceUID = GetResourceUID(strResourceName)

If lngResourceUID = 0 Then
'Add the Resource
lngResourceUID =
ActiveProject.Resources.Add(strResourceName)
End If

'''''
'We have the Resource UID now, so we can update the
assignments
'''''
strResourceID =
CLng(ActiveProject.Resources.UniqueID(lngResourceUID).ID)

'Check to see if we need to add this Assignment
lngAssignmentUID = GetAssignmentUID(strTaskID,
strResourceID)

If lngAssignmentUID = 0 Then
'Add the Assignment
lngAssignmentUID =
tskTask.Assignments.Add(strTaskID, strResourceID, "1")
End If

'Update the hour assigments
strWorkEntryDate = objRS("TimeEntryDate")

'Work is stored in seconds so multiply by 60
strWork = objRS("SumOfHours") * 60


tskTask.Assignments.UniqueID(lngAssignmentUID).TimeScaleData(strWorkEntryDate,
strWorkEntryDate, pjAssignmentTimescaledActualWork, pjTimescaleWeeks,
1).Item(1).Value = strWork

'Get the next record if it exists
objRS.MoveNext
Loop

'''''''''''''''''''''''''''''''''''''
'Update the Task level Info, we want to do this last so
'the time reporting is not skewed
'''''''''''''''''''''''''''''''''''''
'Update the Actual Start Date
tskTask.ActualStart = strStartDate

'Update the Actual End Date
tskTask.ActualFinish = strEndDate
Else
'Since this returned and EOF condition, make a call into
'the PTR system by its self to see if the project was
'Closed or cancelled with no time assigned.
'Close the RS
objRS.Close

'Build the PTR_Master call
strSQL = "SELECT Project_Status, Close_Dt, Entry_Date "
& _
"FROM PTR_Master " & _
"WHERE Project_No = '" & strTaskISRNbr & "';"

'Make the SQL call
Call objRS.Open(strSQL, objConn)

If Not objRS.EOF Then
strStatus = objRS("Project_Status")

If strStatus <> "OPEN" Then
'Just complete it. We don't need to know if
this was
'a COMPLETED or CANCELLED Project at this time.
'tskTask.PercentComplete = "100%"

'Update the Actual Start Date
't.Date3 = CStr(objRS("Entry_Date"))
tskTask.ActualStart = CStr(objRS("Entry_Date"))

'Update the Actual End Date
't.Date1 = CStr(objRS("Close_Dt"))
tskTask.ActualFinish = CStr(objRS("Close_Dt"))
End If
End If
End If

'Close the RS
objRS.Close
End If
End If
Next

GoTo NormalExit

ErrorHandler:
strErrors = strErrors & strFunctionSub & "::Unexpected Error Occurred:"
& vbCrLf & vbCrLf
strErrors = strErrors & "Error: " & Err.Number & "-" & Err.Description

Resume NormalExit

NormalExit:
Set objRS = Nothing
Set objConn = Nothing
End Sub

This is the line that I am having trouble with:
tskTask.Assignments.UniqueID(lngAssignmentUID).TimeScaleData(strWorkEntryDate,
strWorkEntryDate, pjAssignmentTimescaledActualWork, pjTimescaleWeeks,
1).Item(1).Value = strWork

Now this code works fine, execpt for the fact that instead of just posting
the number of hours/minutes for that week, it will sometimes add hours in
surrounding weeks. So instead of posting 30 hours / 180 mintues into the
week of 3/17/2006, it will post 180 minutes in the week of 3/17/2006 AND 240
hours in the week of 3/24/2006 AND 240 hours in the week of 3/31/2006.

I have not been able to find any Best Practices of using this method
(TimeScaleData). Any help or pointers would be greatly appreciated.

 

[LarryPritchard]

Now this code works fine, execpt for the fact that instead of just posting
the number of hours/minutes for that week, it will sometimes add hours in
surrounding weeks. So instead of posting 30 hours / 180 mintues into the
week of 3/17/2006, it will post 180 minutes in the week of 3/17/2006 AND 240
hours in the week of 3/24/2006 AND 240 hours in the week of 3/31/2006.

Sorry, it is posting 240 minutes not hours as stated above

 

[Rod Gill]

If you convert what's in strWork to a number of minutes, does that work?
What sample values does strWork have in it?

 

[LarryPritchard]

The strWork value is a number of hours for that week. So for example it
could be any value from .5 hours to 50 hours.

I found that when I add the hours via the TimeScaleData method, it is stored
in minutes format, so that is why I have to multiply the strWork by 60 so if
the hours was .5 then strWork would contain 30 (minutes). If the hours was
50 then strWork would contain 300 (minutes).

Thanks,
Larry

 

[Rod Gill]

With a name like strWork I assumed it was a string. If it is, try making it
a Long value holding the number of minutes instead.

Ah, reading you code I see that everything is declared as a variant. It is
much better practice to never declare variables as a variant unless
necessary. Variants don't provide error checking. strWork could be a string
and when passed to something that expects a long it may not get converted
properly and an error raised. By having properly declared variables such as
Work as Long the compile will catch many errors. In addition calling a
variable strWork suggests it has been declared as a string when it hasn't
and all sorts of errors can arise from this, especially when someone else
tries to maintain your code.

Ditto with the data code. You should create a reference to OledDB then your
code would be
Dim conn As ADODB.Connection
Dim RS As ADODB.Recordset

Again the compile will pick up errors that would otherwise create annoying
run time errors.

By the way your code would also run faster and more reliably.

 

[Jan De Messemaeker]

Hi,

Just a hunch.
When the updating of the assignment has as a resoult that the task is 100%
done, later extending the task by setting an actual finish will not remove
the status of 100% complete; work and thus actual work will be generated for
the extra weeks.
Hope this helps,

 

[LarryPritchard]

Thanks for that pointer Rod. Our shop has been in the habbit to not type our
variables in ASP/VBScripting, so I carried that forward in the VBA code.

I have typed all my variables correctly. This still did not correct the
'phantom' hours that appeared. See Jan De Messemaeker's comment below for
another response from me.

Thanks,
Larry

 

[LarryPritchard]

Thanks for that pointer Jan, I didn't even think about that.

I adjusted my code so instead of setting the Finish date to an unrelated
developer specified date, I update the tskTask.Duration =
tskTask.ActualDuration.

This has corrected the many extra hours that were added when the finish date
was set. But a few hours are still being added to one of my resources for a
given task/assignment.

Is there a better method of completing a task, so extra 'phantom' hours
don't get added to any of the assigned resources?

Thanks,
Larry

Here is my updated function:
'=====================================================================
'= Sub Step1_UpdateActualWork(strErrors)
'= Description: This sub will apply the programmer submitted hours
'=====================================================================
Sub Step1_UpdateActualWork(ByRef strErrors)
'These are used after Referencing the
'Microsoft OLE DB ActiveX data object library
Dim objConn As ADODB.Connection
Dim objRS As ADODB.Recordset

Dim strFunctionSub As String
Dim tskTask As Task
Dim strTaskISRNbr As String
Dim strSQL As String
Dim strStatus As String
Dim strEndDate As String
Dim strStartDate As String
Dim strResourceName As String
Dim strWorkEntryDate As String
Dim lngResourceUID As Long
Dim lngResourceID As Long
Dim lngAssignmentUID As Long
Dim lngTaskUID As Long
Dim lngTaskID As Long
Dim dblWork As Double
Dim dblActualDuration As Double
Dim dblPendingWork As Double
Dim strValue As String
Dim intDurationToAdd As Integer

On Error GoTo ErrorHandler
strFunctionSub = "Step1_UpdateActualWork"

'Create local objects
Set objConn = CreateObject("ADODB.Connection")
Set objRS = CreateObject("ADODB.RecordSet")

'Open the connection object
objConn.Open g_strConnectInfo

'Loop thru all the Tasks so we can calculate the total hours worked.
For Each tskTask In ActiveProject.Tasks
'We only want to calculate on the tasks that
'have this Text10 Value (ISR Nbr)
strTaskISRNbr = tskTask.Text10

If strTaskISRNbr <> "" Then
'We don't want to update the project if it is complete
If tskTask.ActualFinish = "NA" Then
Debug.Print "ISR: " & strTaskISRNbr
'Get the project info
strSQL = "SELECT PTR.Project_No, PTR.Project_Name,
PTR.Entry_Date, PTR.Close_Dt, PTR.Project_Status, P.Change_ID, Sum(P.Hours)
AS SumOfHours, P.Entry_Date As TimeEntryDate " & _
"FROM dbo.Project_Time P INNER JOIN dbo.PTR_Master PTR ON
P.Project_No = PTR.Project_No " & _
"WHERE PTR.Project_No = '" & strTaskISRNbr & "' And
P.Change_ID Is Not Null And P.Entry_Date > '" & g_strSearchBeginDate & "' And
P.Entry_Date <= '" & g_strSearchEndDate & "' And P.Hours > 0 " & _
"GROUP BY PTR.Project_No, PTR.Project_Name, PTR.Entry_Date,
PTR.Close_Dt, PTR.Project_Status, P.Change_ID, P.Entry_Date " & _
"ORDER BY PTR.Project_No, P.Entry_Date;"

'Make the SQL call
Call objRS.Open(strSQL, objConn)

If Not objRS.EOF Then
'First use the TaskUID for lookups
lngTaskUID = CLng(tskTask.UniqueID)

'Status will be OPEN or COMPLETED or CANCELLED
strStatus = objRS("Project_Status")

'Set the Begin/End Dates
strStartDate = CStr(objRS("Entry_Date"))

If UCase(strStatus) = "OPEN" Then
'Set the End Date = NA
strEndDate = "NA"
Else
strEndDate = CStr(objRS("Close_Dt"))
End If

'Loop thru multiple resources that could of worked
'on this Task
Do While Not objRS.EOF
'What resource are we looking for?
strResourceName = UCase(objRS("Change_ID"))
Debug.Print " Resource: " & strResourceName

'Get the TaskUID or 0 if it doesn't exist
lngResourceUID = GetResourceUID(strResourceName)

If lngResourceUID = 0 Then
'Add the Resource
lngResourceUID =
CLng(ActiveProject.Resources.Add(strResourceName))
End If

'''''
'We have the Resource UID now, so we can update the
assignments
'''''
lngResourceID =
CLng(ActiveProject.Resources.UniqueID(lngResourceUID).ID)

'Check to see if we need to add this Assignment
lngTaskID = CLng(tskTask.ID)
lngAssignmentUID = GetAssignmentUID(lngTaskID,
lngResourceID)

If lngAssignmentUID = 0 Then
'Add the Assignment
lngAssignmentUID =
CLng(tskTask.Assignments.Add(lngTaskID, lngResourceID, 1))
End If

'Make sure the resource/assignment is 100% for all
resources
Dim aAssignment As Assignment

For Each aAssignment In tskTask.Assignments
aAssignment.Units = 1
Next

'Update the hour assigments
strWorkEntryDate = objRS("TimeEntryDate")

'Get the current posted hours
strValue = tskTask.ActualDuration
If strValue = "" Then
strValue = "0"
End If
dblActualDuration = CDbl(strValue)
Debug.Print " Actual Duration = " &
dblActualDuration

'Work is stored in minutes so multiply the hours by 60
dblWork = CDbl(objRS("SumOfHours")) * 60
Debug.Print " Work Date: " & strWorkEntryDate
Debug.Print " Current Work: " & dblWork

'What amount do we want to try and post to the task?
dblPendingWork = dblActualDuration + dblWork

'We don't want to auto complete the task, we want to
adjust the duration
'up so the %complete will be around 90% or so
If tskTask.Duration < dblPendingWork Then
'We want to finish out the week
intDurationToAdd = 2400 - (dblPendingWork -
tskTask.Duration)
If intDurationToAdd <= 0 Then
intDurationToAdd = 240 'one day at least
End If

tskTask.Duration = tskTask.Duration +
intDurationToAdd
Debug.Print " *** Duration Updated: " &
tskTask.Duration & " ***"

End If

'Post the hours

tskTask.Assignments.UniqueID(lngAssignmentUID).TimeScaleData(strWorkEntryDate,
strWorkEntryDate, pjAssignmentTimescaledActualWork,
pjTimescaleWeeks).Item(1).Value = dblWork
Debug.Print " Duration After hours added: " &
tskTask.Duration
Debug.Print " Actual Duration After hours
added: " & tskTask.ActualDuration

'Get the next record if it exists
objRS.MoveNext
Loop

'Update the Actual End Date
If strEndDate <> "NA" Then
'tskTask.ActualFinish = strEndDate
tskTask.Duration = tskTask.ActualDuration
Debug.Print " Duration After Finish Date
updated: " & tskTask.Duration
Debug.Print " ActualDuration After Finish Date
updated: " & tskTask.ActualDuration
End If
Else
'Since this returned and EOF condition, make a call into
'the PTR system by its self to see if the project was
'Closed or cancelled with no time assigned.
'Close the RS
objRS.Close

'Build the PTR_Master call
strSQL = "SELECT Project_Status, Close_Dt, Entry_Date "
& _
"FROM PTR_Master " & _
"WHERE Project_No = '" & strTaskISRNbr & "';"

'Make the SQL call
Call objRS.Open(strSQL, objConn)

If Not objRS.EOF Then
strStatus = objRS("Project_Status")

If strStatus <> "OPEN" Then
'Just complete it. We don't need to know if
this was
'a COMPLETED or CANCELLED Project at this time.
'tskTask.PercentComplete = "100%"

'Update the Actual Start Date
't.Date3 = CStr(objRS("Entry_Date"))
tskTask.ActualStart = CStr(objRS("Entry_Date"))

'Update the Actual End Date
't.Date1 = CStr(objRS("Close_Dt"))
tskTask.ActualFinish = CStr(objRS("Close_Dt"))
End If
End If
End If

'Close the RS
objRS.Close
End If
End If
Next

GoTo NormalExit

ErrorHandler:
strErrors = strErrors & strFunctionSub & "::Unexpected Error Occurred:"
& vbCrLf & vbCrLf
strErrors = strErrors & "Error: " & Err.Number & "-" & Err.Description

Resume NormalExit

NormalExit:
Set objRS = Nothing
Set objConn = Nothing
End Sub

Now when I review the Resource Usage I see the following for Actual Hours:

7/31 8/7 8/14 8/21
-KYW
Task1 29h 0h 13h 4.97h
-LHP
Task1 0h 0h 3h 52h

The 52h entry is not actual work. the 3h should of been the last actual
hours posted for this assignment/resource. This 52h entry is added by
project after I set the duration = actual.duration.

Thanks for any ideas,
Larry