G
Guest
I have a peice of code that has become unacceptably long-running and ties up
the UI for too long. I'm looking for a solution. It used to be just the
task that had start and complete dates but now it is each person working on
the task has a start and complete date.
The code calculates the duration of a task. Here is an explaination. A
task can have many people working on it. Each person has a date the task was
issued to them and a date of which they complete their portion of the task.
To accurately calculate the duration I take the minimum Issued date and
maximum complete date or today if it's not complete and compaired each day to
a table of days that are marked as working days or not. If the day is a
working day then the duration is incramented. Any suggestions?
Public Function fTaskDuration(intTaskID As Integer) As Integer
Dim cnn As Connection
Set cnn = CurrentProject.Connection
Dim sql As String
Dim rst As New ADODB.Recordset
'get min Issued date and max complete date and for each day between the
'two count it if it falls within the working period of one of then people it
is assigned to.
'get min Issued Date
Dim minIssuedDate As Date
sql = "SELECT Min(TaskUserRole.IssuedDate) AS MinOfIssuedDate " & _
"FROM TaskUserRole WHERE (((TaskUserRole.TaskID)=" & intTaskID & "));"
rst.Open sql, cnn, adOpenStatic, adLockReadOnly
If IsNull(rst.Fields("MinOfIssuedDate")) Then 'nobody started working on
it yet
rst.Close
GoTo Exit_fTaskDuration:
End If
minIssuedDate = rst.Fields("MinOfIssuedDate")
rst.Close
'If they are still working on it set max CompleteDate = today
Dim maxCompletedDate As Date
sql = "SELECT TaskUserRole.CompletedDate " & _
"FROM TaskUserRole WHERE (((TaskUserRole.CompletedDate) Is Null) AND
((TaskUserRole.TaskID)=" & intTaskID & "));"
rst.Open sql, cnn, adOpenStatic, adLockReadOnly
If rst.EOF Or rst.BOF Then
maxCompletedDate = Date
rst.Close
Else
rst.Close
'Get max Complete date
sql = "SELECT Max(TaskUserRole.CompletedDate) AS MaxOfCompletedDate " & _
"FROM TaskUserRole WHERE (((TaskUserRole.TaskID)=" & intTaskID &
"));"
rst.Open sql, cnn, adOpenStatic, adLockReadOnly
maxCompletedDate = rst.Fields("MaxOfCompletedDate")
rst.Close
End If
Dim d As Date
d = minIssuedDate
Do While d <= maxCompletedDate
sql = "SELECT TaskUserRole.TaskID " & _
"FROM TaskUserRole " & _
"WHERE (((TaskUserRole.TaskID)=" & intTaskID & ") AND " & _
"((TaskUserRole.IssuedDate)<=#" & d & "#) AND " & _
"((TaskUserRole.CompletedDate)>=#" & d & "# Or
(TaskUserRole.CompletedDate) Is Null));"
rst.Open sql, cnn, adOpenStatic, adLockReadOnly
If Not rst.EOF And Not rst.BOF Then
'if it is a working day then count it
If DLookup("WorkingDay", "Days", "[TheDate]=#" & d & "#") = "-1" Then
fTaskDuration = fTaskDuration + 1
End If
End If
rst.Close
d = d + 1
Loop
fTaskDuration = Format(fTaskDuration, 0)
Exit_fTaskDuration:
Set rst = Nothing
cnn.Close
Set cnn = Nothing
End Function
the UI for too long. I'm looking for a solution. It used to be just the
task that had start and complete dates but now it is each person working on
the task has a start and complete date.
The code calculates the duration of a task. Here is an explaination. A
task can have many people working on it. Each person has a date the task was
issued to them and a date of which they complete their portion of the task.
To accurately calculate the duration I take the minimum Issued date and
maximum complete date or today if it's not complete and compaired each day to
a table of days that are marked as working days or not. If the day is a
working day then the duration is incramented. Any suggestions?
Public Function fTaskDuration(intTaskID As Integer) As Integer
Dim cnn As Connection
Set cnn = CurrentProject.Connection
Dim sql As String
Dim rst As New ADODB.Recordset
'get min Issued date and max complete date and for each day between the
'two count it if it falls within the working period of one of then people it
is assigned to.
'get min Issued Date
Dim minIssuedDate As Date
sql = "SELECT Min(TaskUserRole.IssuedDate) AS MinOfIssuedDate " & _
"FROM TaskUserRole WHERE (((TaskUserRole.TaskID)=" & intTaskID & "));"
rst.Open sql, cnn, adOpenStatic, adLockReadOnly
If IsNull(rst.Fields("MinOfIssuedDate")) Then 'nobody started working on
it yet
rst.Close
GoTo Exit_fTaskDuration:
End If
minIssuedDate = rst.Fields("MinOfIssuedDate")
rst.Close
'If they are still working on it set max CompleteDate = today
Dim maxCompletedDate As Date
sql = "SELECT TaskUserRole.CompletedDate " & _
"FROM TaskUserRole WHERE (((TaskUserRole.CompletedDate) Is Null) AND
((TaskUserRole.TaskID)=" & intTaskID & "));"
rst.Open sql, cnn, adOpenStatic, adLockReadOnly
If rst.EOF Or rst.BOF Then
maxCompletedDate = Date
rst.Close
Else
rst.Close
'Get max Complete date
sql = "SELECT Max(TaskUserRole.CompletedDate) AS MaxOfCompletedDate " & _
"FROM TaskUserRole WHERE (((TaskUserRole.TaskID)=" & intTaskID &
"));"
rst.Open sql, cnn, adOpenStatic, adLockReadOnly
maxCompletedDate = rst.Fields("MaxOfCompletedDate")
rst.Close
End If
Dim d As Date
d = minIssuedDate
Do While d <= maxCompletedDate
sql = "SELECT TaskUserRole.TaskID " & _
"FROM TaskUserRole " & _
"WHERE (((TaskUserRole.TaskID)=" & intTaskID & ") AND " & _
"((TaskUserRole.IssuedDate)<=#" & d & "#) AND " & _
"((TaskUserRole.CompletedDate)>=#" & d & "# Or
(TaskUserRole.CompletedDate) Is Null));"
rst.Open sql, cnn, adOpenStatic, adLockReadOnly
If Not rst.EOF And Not rst.BOF Then
'if it is a working day then count it
If DLookup("WorkingDay", "Days", "[TheDate]=#" & d & "#") = "-1" Then
fTaskDuration = fTaskDuration + 1
End If
End If
rst.Close
d = d + 1
Loop
fTaskDuration = Format(fTaskDuration, 0)
Exit_fTaskDuration:
Set rst = Nothing
cnn.Close
Set cnn = Nothing
End Function