Random Thunks

Waiting for the nested hierarchical tasks functionality in TFS 2010 is not currently an option for me right now in my quest to process tasks from MS Project 2007. Nor is manually updating each task title within Project to keep some sort of structure since that would be a real pain and be largely un-maintainable once you have more than a few tasks.

Now it’s been a long while since I last messed around with VBA, so this is probably pretty ugly – however it does do the trick. In addition to keeping the hierarchical naming structure, it also marks summary tasks as not publishable to avoid polluting TFS with them.

The entry point is HierarchicalTaskNames().

Dim TitleStack As CollectionDim taskId As Integer

Sub RecursiveScanAndFix(ByRef t As Task)    Dim child As Task    Dim i As Integer    Dim text As String

    text = t.Name

    ' If this task has children then add the name to the stack and continue on down    If t.OutlineChildren.Count > 0 Then        Push(text)        t.Text25 = "No"        ' Now look for the children

        For Each child In t.OutlineChildren            RecursiveScanAndFix(child)        Next child

        Pop()

    Else        ' No, no children found. So these will be actual tasks. Therefore we need to prepend the hierarchy name onto the task        ' First off look to see if we've already named this. If so we'll strip the previous hierarchical name off before we start        If Left(text, 1) = "[" Then            ' Yes we have. Hunt down the last ] and remove it from the text            For i = Len(text) To 1 Step -1                If Mid(text, i, 1) = "]" Then                    text = Mid(text, i + 1)                    Exit For                End If            Next            text = Trim(text)        End If

        ' Now add the hierarchical name to the task title

        t.Name = GetTitleFromStack & " " & text

        taskId = t.ID    End IfEnd Sub

Sub HierarchicalTaskNames()    Dim t As Task    taskId = 1    TitleStack = New Collection

    While taskId <= ActiveProject.NumberOfTasks        t = ActiveProject.Tasks(taskId)        If t.OutlineChildren.Count > 0 Then            RecursiveScanAndFix(ActiveProject.Tasks(taskId))        End If        taskId = taskId + 1    End WhileEnd Sub

Function Pop() As String    If TitleStack.Count > 0 Then        Pop = TitleStack.Item(TitleStack.Count)        TitleStack.Remove(TitleStack.Count)    End IfEnd Function

Function Push(ByVal Title As String)    TitleStack.Add(Title)End Function

Function GetTitleFromStack() As String    GetTitleFromStack = "[ "    Dim i As Integer

    For i = 1 To TitleStack.Count        GetTitleFromStack = GetTitleFromStack & TitleStack.Item(i)        If i <> TitleStack.Count Then            GetTitleFromStack = GetTitleFromStack & " | "        End If    Next

    GetTitleFromStack = GetTitleFromStack & " ]"End Function

MS Project 2007 SP1