Condividi tramite


Quick and Dirty Schedule Auditing

Here is some starter code for doing quick checks of the tasks in a project. This code will create a ‘report’ that shows the tasks that have estimated durations, tasks that are not fixed work and tasks that do not have any resources assigned. It also collects the names of resources that are not assigned to any tasks.

It should be noted that there are real products out there like QuantumPMs Quantum Schedule Auditor that does this in a much more sophisticated way (you should check out that product if you need to do more systematic and regular auditing.)

But that said if you need to do quick checks here is some code that shows some sample checks and a way to put the results into the clipboard so you can paste it into Word or Excel.

It is possible to have all the report building stuff on one big line but I like to break this kind of thing out on several lines. It makes it easier to add new stuff into the middle of the report.

Sub ProjectChecker()
Dim t As Task
Dim r As Resource

Dim EstimatedDurCount As Integer
Dim EstimatedDurTask As String

Dim NotFixedWorkCount As Integer
Dim NotFixedWorkTask As String

Dim NoResourceAssignedCount As Integer
Dim NoResourceAssignedTask As String

Dim ResWithNoAssignCount As Integer
Dim ResWithNoAssignResource As String

Dim Report As String
Dim MyData As DataObject
Set MyData = New DataObject

For Each t In ActiveProject.Tasks
If Not (t Is Nothing) Then
If t.Estimated = True And t.Summary = False Then
EstimatedDurCount = EstimatedDurCount + 1
EstimatedDurTask = EstimatedDurTask + t.Name & Chr(13)
End If
If t.Type <> pjFixedWork And t.Summary = False Then
NotFixedWorkCount = NotFixedWorkCount + 1
NotFixedWorkTask = NotFixedWorkTask + t.Name & Chr(13)
End If
If t.Milestone = False And t.Summary = False And t.Resources.Count = 0 Then
NoResourceAssignedCount = NoResourceAssignedCount + 1
NoResourceAssignedTask = NoResourceAssignedTask + t.Name & Chr(13)
End If
End If
Next t

For Each r In ActiveProject.Resources
If Not (r Is Nothing) Then
If r.Assignments.Count = 0 Then
ResWithNoAssignCount = ResWithNoAssignCount + 1
ResWithNoAssignResource = ResWithNoAssignResource + r.Name + Chr(13)
End If
End If
Next r

'Building Report
Report = "Project Name: " & ActiveProject.Name & Chr(13) & Chr(13)
Report = Report & "**** Tasks Section ****" & Chr(13)
Report = Report & "Count of tasks with Estimated Durations: " & EstimatedDurCount & Chr(13)
Report = Report & EstimatedDurTask & Chr(13)
Report = Report & "Count of tasks that are NOT Fixed Work: " & NotFixedWorkCount & Chr(13)
Report = Report & NotFixedWorkTask & Chr(13)
Report = Report & "Count of tasks without a resource assignment: " & NoResourceAssignedCount & Chr(13)
Report = Report & NoResourceAssignedTask & Chr(13)
Report = Report & Chr(13) & "****Resource Section****" & Chr(13)
Report = Report & "Count Resources with No Assignments: " & ResWithNoAssignCount & Chr(13)
Report = Report & ResWithNoAssignResource & Chr(13)

MyData.SetText Text:=Report
MyData.PutInClipboard

End Sub