Search code examples
vbaparsingms-project

Microsoft project -Scan and transfer Task Usage View data

In Microsoft Project 2016, I am writing VBA to extract cell data from the task usage view, grouping data by the Resource Name, then summarizing all of the Remaining Hours and Remaining Costs for each resource. I use a Traceback VBA procedure to trace all predecessors from the single target task. Using the "marked" flag to identify all tasks which are incomplete predecessors should allow me to calculate Estimates to Complete to any task in the project. The Procedure thus far sets up tables, filters and a view to enable prior to displaying the Task Usage custom view and transferring the data to the array.

Note that from the debug info later, that there are 24 tasks in the Traceback! Only 2 are displaying data in this Sub.

Task Usage example

I have had some success in reading some of the task data and some of the assignment data, but I have not had consistent results. The call Create TaskUsage View creates a new Task Usage view based on the current traceback of tasks. Here is the code so far:

 Sub NewArrayLoad()

 Dim FilteredTasks As tasks
 Dim ArrayIndex As Integer, iCtr As Integer, ArrayCtr As Integer, tCtr As Integer
 Dim arrResNames() As Variant, arrResSpread As Variant, ResCt As Integer, LoopCount As Integer, 
    MyCheckn As Boolean, MyCheckA As Boolean, r As Resource, AA As Assignment


enter code here
Call CreateNewTaskUsage("TaskUsage")

ReDim arrResNames(1 To ActiveProject.Resources.Count)
Myfile = "C:\Macros\MCS.txt"

FExists (Myfile)
If FileExists = True Then
    sbDeleteAFile (Myfile)
End If

'Loads resources from project into an array
For ResCt = 1 To ActiveProject.Resources.Count
    arrResNames(ResCt) = ActiveProject.Resources(ResCt).name
    OutputStr = ("2046 - CreateProjectPDFforSRA - Resource added = " & arrResNames(ResCt))
    Call Txt_Append(Myfile, OutputStr)
Next ResCt


Set FilteredTasks = ActiveSelection.tasks
Application.SelectAll
ReDim arrResSpread(1 To ActiveSelection.tasks.Count, 1 To 4 * (ResCt - 1) + 2)
Debug.Print (" Count of tasks in selection = " & ActiveSelection.tasks.Count)

ArrayIndex = 0
ArrayCtr = 1
tCtr = 1
 
For Each t In FilteredTasks
        SelectRow row:=tCtr, RowRelative:=False, Height:=2, Add:=False
        Debug.Print ("Current Row = " & tCtr)
        ArrayIndex = ArrayIndex + 1
        arrResSpread(ArrayIndex, ArrayCtr) = ActiveSelection.tasks(tCtr).ID
        arrResSpread(ArrayIndex, ArrayCtr + 1) = ActiveSelection.tasks(tCtr).name
        Debug.Print ("1-Current Row after down = " & tCtr)
            For Each r In ActiveCell.Task.Resources
                tCtr = tCtr + 1
                For Each AA In ActiveCell.Task.Assignments
                    Debug.Print ("ArrayIndex = " & ArrayIndex & " ArrayCtr = " & ArrayCtr)
                         arrResSpread(ArrayIndex, ArrayCtr + 2) = AA.ResourceName
                         For iCtr = 1 To ResCt - 1
                            If arrResNames(iCtr) = AA.ResourceName Then
                                SelectRow row:=tCtr, RowRelative:=True, Height:=2, Add:=False
                                MyCheckn = IsNull(ResName)
                                MyCheckA = IsEmpty(ResName)
                                If MyCheckn = False Or MyCheckA = False Then
                              
                                    '   Debug.Print "2-t.id=" & ActiveSelection.tasks(tCtr).ID & " t.name= " & ActiveSelection.tasks(tCtr).name
                                    arrResSpread(ArrayIndex, ArrayCtr + 2) = AA.ResourceName
                                    arrResSpread(ArrayIndex, ArrayCtr + 2 + iCtr) = AA.Work / 60
                                    arrResSpread(ArrayIndex, ArrayCtr + 3 + iCtr) = AA.RemainingWork / 60
                                    arrResSpread(ArrayIndex, ArrayCtr + 4 + iCtr) = AA.Cost
                                    arrResSpread(ArrayIndex, ArrayCtr + 5 + iCtr) = AA.RemainingCost
                                    Debug.Print ("2-Current Row after down = " & tCtr)
                                    Debug.Print ("ICtr=" & iCtr & " ResName=" & AA.ResourceName & " AA.Work= " & AA.RemainingWork / 60 & " RemCost=" & AA.RemainingCost)
                                tCtr = tCtr + 1
                             
                                End If
                               Debug.Print arrResSpread(ArrayIndex, 1) & "-" & arrResSpread(ArrayIndex, 2) & "-" & arrResSpread(ArrayIndex, 3) & "-" & arrResSpread(ArrayIndex, 4) & "-" _
                                & arrResSpread(ArrayIndex, 5) & "-" & arrResSpread(ArrayIndex, 6) & "-" & arrResSpread(ArrayIndex, 7) & "-" & arrResSpread(ArrayIndex, 8) & "-" & arrResSpread(ArrayIndex, 9) & "-" & arrResSpread(ArrayIndex, 10)
                                    
                            End If
                        Next iCtr
                        ArrayIndex = ArrayIndex + 1
                    Next AA
                    ArrayIndex = ArrayIndex + 1
            Next r
Next t

End Sub

I am having issues in : -Reading the task segment data i.e, the Task.ID and the Task.Name for any task after the 1st task -Reading the assignments beyond the 1st 2 tasks. I appear to be unable to discern that when I advance a row, whether the "ID" column contains a New task ID, and this should have a new array task entry and when to exit adding new assignments.

Example Debug data from running the code. Debug Data

Note that Task 284 was read and loaded into the array as desired. Task 285 was skipped and task 286 only contains assignment data, no tasks id or name. Tasks 287 to the end were not picked up at all.

I know that I am not properly reading the information row by row like I want, and it appears that task ID and Task Name access the data on the task Usage differently than the assignment data. I cannot place a request to extract the task ID, for example, when I am also accessing the assignment.

A solution might be to simple export the task Usage view to excel, where I can parse the data but I am trying to avoid having to use excel as an intermediary. Do you have any suggestions?

Solution

  • I am having issues in : -Reading the task segment data i.e, the Task.ID and the Task.Name for any task after the 1st task -Reading the assignments beyond the 1st 2 tasks. I appear to be unable to discern that when I advance a row, whether the "ID" column contains a New task ID, and this should have a new array task entry and when to exit adding new assignments.

    Yes, reading values by selecting them from a view is prone to challenges. A better way is to use the object model to step through the 'rows' and fields. In this case the rows are a mix of tasks and their assignments.

    I modified the code to loop through the task collection object, FilteredTasks, and for each task, to loop through its assignments:

    Sub NewArrayLoad()

Dim FilteredTasks As Tasks
Dim ArrayIndex As Integer, ArrayCtr As Integer
Dim arrResNames() As Variant, arrResSpread As Variant, ResCt As Integer
Dim AA As Assignment
Dim OutputStr As String

ReDim arrResNames(1 To ActiveProject.Resources.Count)

Dim Myfile As String
Myfile = "C:\Macros\MCS.txt"
If Dir(Myfile) <> "" Then
    Kill Myfile
End If

'Loads resources from project into an array
For ResCt = 1 To ActiveProject.Resources.Count
    arrResNames(ResCt) = ActiveProject.Resources(ResCt).Name
    OutputStr = ("2046 - CreateProjectPDFforSRA - Resource added = " & arrResNames(ResCt))
    Call Txt_Append(Myfile, OutputStr)
Next ResCt

Set FilteredTasks = ActiveSelection.Tasks
ReDim arrResSpread(1 To FilteredTasks.Count, 1 To 5 * (ResCt - 1) + 2)

ArrayIndex = 0
 
Dim t As Task
For Each t In FilteredTasks
    
    ArrayIndex = ArrayIndex + 1
    arrResSpread(ArrayIndex, 1) = t.ID
    arrResSpread(ArrayIndex, 2) = t.Name
        
    For Each AA In t.Assignments
    
        ArrayCtr = AA.Resource.ID
        arrResSpread(ArrayIndex, 2 + (ArrayCtr - 1) * 5 + 1) = AA.ResourceName
        arrResSpread(ArrayIndex, 2 + (ArrayCtr - 1) * 5 + 2) = AA.Work / 60
        arrResSpread(ArrayIndex, 2 + (ArrayCtr - 1) * 5 + 3) = AA.RemainingWork / 60
        arrResSpread(ArrayIndex, 2 + (ArrayCtr - 1) * 5 + 4) = AA.Cost
        arrResSpread(ArrayIndex, 2 + (ArrayCtr - 1) * 5 + 5) = AA.RemainingCost
            
        Dim i As Integer, s As String
        s = vbNullString
        For i = 1 To UBound(arrResSpread, 2)
            s = s & "-" & arrResSpread(ArrayIndex, i)
        Next i
        Debug.Print Mid$(s, 2)
                   
    Next AA
Next t

' presumably arrResSpread is written out to the Myfile at this point

End Sub