Exporting Outlined Task Timephased Data from Microsoft Project
In the previous post you’ve seen how is it possible to get each resource’s work and cost divided on a monthly basis across the entire project into Microsoft Excel spreadsheet.
You can get timephased data for resources, tasks and assignments. All relevant data fields are available. You can find more information in the description of TimeScaleData method.
With task data it gets a bit tricky to export as they are hierarchically structured. By exporting everything, you won’t be able to sum them up. Here you have two options:
- Export only non summary tasks (If Not Task.Summary Then …),
- or export the outline structure as well.
And here’s how you do it:
Sub ExportTimephasedTaskData()
' Sub will export timephased taskdata (work) into Excel worksheet
' Define time interval for timephased data
Dim Start, Finish As String
Start = "1.1.2004"
Finish = "31.5.2004"
' Define timescale unit. Can be one of the following PjTimescaleUnit constants:
' pjTimescaleYears, pjTimescaleQuarters, pjTimescaleMonths, pjTimescaleWeeks,
' pjTimescaleDays, pjTimescaleHours, pjTimescaleMinutes
Dim TimescaleUnit As PjTimescaleUnit
TimescaleUnit = pjTimescaleMonths
Dim Pj As Project
Dim PjRes As Resources
Dim PjTasks As Tasks
Dim XlApp As Excel.Application
Dim IdSheet As Integer
Dim XlSheet As Excel.Worksheet
Dim XlBook As Excel.Workbook
Set Pj = ActiveProject
Set PjTasks = Pj.Tasks
Dim PjTask As Task
Set XlApp = New Excel.Application
XlApp.Visible = False
Set XlBook = XlApp.Workbooks.Add
XlBook.Title = Pj.Title
Set XlSheet = XlBook.ActiveSheet
Dim TSVWork As TimeScaleValues
Dim T As Long
Dim Ts As Long
Dim Row As Integer
Dim d As Single
Dim CurrencyFormat As String
' Choose work unit divisor depending on the Tools | Options | Schedule | Work.
' Work is stored in minutes in MS Project.
Select Case Pj.DefaultWorkUnits
Case pjMinute
d = 1
Case pjHour
d = 60
Case pjDay
d = Pj.HoursPerDay * 60
Case pjWeek
d = Pj.HoursPerWeek * 60
Case pjMonthUnit
d = Pj.DaysPerMonth * Pj.HoursPerDay * 60
Case Else
d = 1
End Select
If Pj.Tasks.Count > 0 Then
XlSheet.Cells(1, 1) = "Task Name"
For T = 1 To PjTasks.Count
Set PjTask = PjTasks(T)
' Set Outline level of the task
XlSheet.Rows(T + 1).OutlineLevel = PjTask.OutlineLevel
XlSheet.Cells(T + 1, 1).Value = PjTask.Name
' Indent tasks
XlSheet.Cells(T + 1, 1).IndentLevel = PjTask.OutlineLevel - 1
XlSheet.Cells(T + 1, 1).AddIndent = True
Set TSVWork = PjTask.TimeScaleData(Start, Finish, _
Type:=pjTaskTimescaledWork, TimescaleUnit:=TimescaleUnit)
For Ts = 1 To TSVWork.Count
If T = 1 Then
XlSheet.Cells(1, 1 + Ts) = TSVWork(Ts).StartDate
End If
Select Case TimescaleUnit
Case pjTimescaleMonths
XlSheet.Cells(1, 1 + Ts).NumberFormat = "Mmm Yy"
End Select
If Not TSVWork(Ts).Value = "" Then
XlSheet.Cells(T + 1, 1 + Ts) = TSVWork(Ts).Value / d
XlSheet.Cells(T + 1, 1 + Ts).NumberFormat = "#,##0"
End If
Next Ts
If PjTask.Summary Then
XlSheet.Rows(T + 1).Font.Bold = True
End If
Next T
XlSheet.Outline.SummaryRow = xlSummaryAbove
End If
XlSheet.Columns.AutoFit
XlApp.ScreenUpdating = True
MSProject.ScreenUpdating = True
AppActivate "Microsoft Project"
XlApp.Visible = True
AppActivate "Microsoft Excel"
End Sub
Result:
![]()