Attribute VB_Name = "Module1" Sub ProjectReaderTaskUsageSample() Dim objReader As Object Dim objProject As Object Dim objTask As Object Dim objAssignment As Object Dim countTask As Long Dim indexTask As Long Dim indexAssignments As Long Dim indexRow As Long Dim Filter As String Dim Caption As String Dim SelectedFile As Variant On Error Resume Next Filter = "MPP files (*.mpp),*.mpp" Caption = "Please Select an MPP File" SelectedFile = Application.GetOpenFilename(Filter, , Caption) If SelectedFile <> False Then Set objReader = CreateObject("ProjectReader.Application") Sheets.Add ActiveSheet.Name = "MicrosoftProjectTaskUsageList" indexRow = 1 'OPEN THE PROJECT Call objReader.openFile(CStr(SelectedFile)) If Err.Number = 0 Then Set objProject = objReader.Project Range("A1:B6").Interior.Color = vbCyan Cells(indexRow, 1) = "Project Name" Cells(indexRow, 2) = objProject.Name indexRow = indexRow + 1 Cells(indexRow, 1) = "Project Author" Cells(indexRow, 2) = objProject.Author indexRow = indexRow + 1 Cells(indexRow, 1) = "Currency Symbol" Cells(indexRow, 2) = objProject.CurrencySymbol indexRow = indexRow + 1 Cells(indexRow, 1) = "Days Per Month" Cells(indexRow, 2) = objProject.DaysPerMonth indexRow = indexRow + 1 Cells(indexRow, 1) = "Minutes Per Week" Cells(indexRow, 2) = objProject.MinutesPerWeek indexRow = indexRow + 1 Cells(indexRow, 1) = "Minutes Per Day" Cells(indexRow, 2) = objProject.MinutesPerDay indexRow = indexRow + 2 countTask = objReader.Project.Tasks.Count Range("B8:W8").Interior.Color = vbYellow Cells(indexRow, 1) = "" Cells(indexRow, 2) = "Task columns:" Cells(indexRow, 3) = "ID" Cells(indexRow, 4) = "UniqueID" Cells(indexRow, 5) = "Name" Cells(indexRow, 6) = "Summary" Cells(indexRow, 7) = "Subproject" Cells(indexRow, 8) = "Milestone" Cells(indexRow, 9) = "Start" Cells(indexRow, 10) = "Finish" Cells(indexRow, 11) = "ActualStart" Cells(indexRow, 12) = "ActualFinish" Cells(indexRow, 13) = "Duration" Cells(indexRow, 14) = "ActualDuration" Cells(indexRow, 15) = "PercentComplete" Cells(indexRow, 16) = "PercentWorkComplete" Cells(indexRow, 17) = "Work" Cells(indexRow, 18) = "ActualWork" Cells(indexRow, 19) = "ActualOvertimeWork" Cells(indexRow, 20) = "Cost" Cells(indexRow, 21) = "ActualCost" Cells(indexRow, 22) = "ActualOvertimeCost" Cells(indexRow, 23) = "OutlineLevel" Cells(indexRow, 24) = "OutlineNumber" indexRow = indexRow + 1 'LOOP FOR EACH TASK, TASKS ARE SORTED BY ID For indexTask = 1 To countTask Set objTask = objReader.Project.Tasks.Item(indexTask) indexRow = indexRow + 1 Range("B" & indexRow & ":B" & indexRow).Interior.Color = vbYellow Cells(indexRow, 1) = "" Cells(indexRow, 2) = "Task -->" Cells(indexRow, 3) = objTask.ID Cells(indexRow, 4) = objTask.UniqueID Cells(indexRow, 5) = objTask.Name Cells(indexRow, 6) = objTask.Summary Cells(indexRow, 7) = objTask.Subproject Cells(indexRow, 8) = objTask.Milestone Cells(indexRow, 9) = objTask.Start Cells(indexRow, 10) = objTask.Finish Cells(indexRow, 11) = objTask.ActualStart Cells(indexRow, 12) = objTask.ActualFinish Cells(indexRow, 13) = objTask.Duration Cells(indexRow, 14) = objTask.ActualDuration Cells(indexRow, 15) = objTask.PercentComplete Cells(indexRow, 16) = objTask.PercentWorkComplete Cells(indexRow, 17) = objTask.Work Cells(indexRow, 18) = objTask.ActualWork Cells(indexRow, 19) = objTask.ActualOvertimeWork Cells(indexRow, 20) = objTask.Cost Cells(indexRow, 21) = objTask.ActualCost Cells(indexRow, 22) = objTask.ActualOvertimeCost Cells(indexRow, 23) = objTask.OutlineLevel Cells(indexRow, 24) = objTask.OutlineNumber 'LOOP FOR EACH ASSIGNMENT For indexAssignments = 1 To objTask.Assignments.Count Set objAssignment = objTask.Assignments.Item(indexAssignments) indexRow = indexRow + 1 Range("C" & indexRow & ":P" & indexRow).Interior.Color = RGB(21, 180, 255) Cells(indexRow, 1) = "" Cells(indexRow, 2) = "" Cells(indexRow, 3) = "Assignment columns:" Cells(indexRow, 4) = "Unique ID" Cells(indexRow, 5) = "Start" Cells(indexRow, 6) = "Finish" Cells(indexRow, 7) = "Actual Start" Cells(indexRow, 8) = "Actual Finish" Cells(indexRow, 9) = "Percent Work Complete" Cells(indexRow, 10) = "Units" Cells(indexRow, 11) = "Work" Cells(indexRow, 12) = "Actual Work" Cells(indexRow, 13) = "Actual Overtime Work" Cells(indexRow, 14) = "Cost" Cells(indexRow, 15) = "Actual Cost" Cells(indexRow, 16) = "Actual Overtime Cost" indexRow = indexRow + 1 Range("C" & indexRow & ":C" & indexRow).Interior.Color = RGB(21, 180, 255) Cells(indexRow, 1) = "" Cells(indexRow, 2) = "" Cells(indexRow, 3) = "Assignment -->" Cells(indexRow, 4) = objAssignment.UniqueID Cells(indexRow, 5) = objAssignment.Start Cells(indexRow, 6) = objAssignment.Finish Cells(indexRow, 7) = objAssignment.ActualStart Cells(indexRow, 8) = objAssignment.ActualFinish Cells(indexRow, 9) = objAssignment.PercentWorkComplete Cells(indexRow, 10) = objAssignment.Units Cells(indexRow, 11) = objAssignment.Work Cells(indexRow, 12) = objAssignment.ActualWork Cells(indexRow, 13) = objAssignment.ActualOvertimeWork Cells(indexRow, 14) = objAssignment.Cost Cells(indexRow, 15) = objAssignment.ActualCost Cells(indexRow, 16) = objAssignment.ActualOvertimeCost indexRow = indexRow + 1 Range("C" & indexRow & ":S" & indexRow).Interior.Color = RGB(255, 150, 100) Cells(indexRow, 1) = "" Cells(indexRow, 2) = "" Cells(indexRow, 3) = "Resource columns:" Cells(indexRow, 4) = "ID" Cells(indexRow, 5) = "Unique ID" Cells(indexRow, 6) = "Name" Cells(indexRow, 7) = "Initials" Cells(indexRow, 8) = "Work" Cells(indexRow, 9) = "Actual Work" Cells(indexRow, 10) = "Overtime Work" Cells(indexRow, 11) = "Actual Overtime Work" Cells(indexRow, 12) = "Regular Work" Cells(indexRow, 13) = "Cost" Cells(indexRow, 14) = "Actual Cost" Cells(indexRow, 15) = "Overtime Cost" Cells(indexRow, 16) = "Actual Overtime Cost" Cells(indexRow, 17) = "Cost Per Use" Cells(indexRow, 18) = "Max Units" Cells(indexRow, 19) = "Standard Rate" indexRow = indexRow + 1 Range("C" & indexRow & ":C" & indexRow).Interior.Color = RGB(255, 150, 100) Cells(indexRow, 1) = "" Cells(indexRow, 2) = "" Cells(indexRow, 3) = "Resource -->" Cells(indexRow, 4) = objAssignment.Resource.ID Cells(indexRow, 5) = objAssignment.Resource.UniqueID Cells(indexRow, 6) = objAssignment.Resource.Name Cells(indexRow, 7) = objAssignment.Resource.Initials Cells(indexRow, 8) = objAssignment.Resource.Work Cells(indexRow, 9) = objAssignment.Resource.ActualWork Cells(indexRow, 10) = objAssignment.Resource.OvertimeWork Cells(indexRow, 11) = objAssignment.Resource.ActualOvertimeWork Cells(indexRow, 12) = objAssignment.Resource.RegularWork Cells(indexRow, 13) = objAssignment.Resource.Cost Cells(indexRow, 14) = objAssignment.Resource.ActualCost Cells(indexRow, 15) = objAssignment.Resource.OvertimeCost Cells(indexRow, 16) = objAssignment.Resource.ActualOvertimeCost Cells(indexRow, 17) = objAssignment.Resource.CostPerUse Cells(indexRow, 18) = objAssignment.Resource.MaxUnits Cells(indexRow, 19) = objAssignment.Resource.StandardRate indexRow = indexRow + 1 Next Set objTask = Nothing Next Else MsgBox Err.Description End If Set objReader = Nothing End If End Sub Sub ProjectReaderResourceListSample() Dim objReader As Object Dim objProject As Object Dim objAssignment As Object Dim countResource As Long Dim indexResource As Long Dim indexRow As Long Dim Filter As String Dim Caption As String Dim SelectedFile As Variant On Error Resume Next Filter = "MPP files (*.mpp),*.mpp" Caption = "Please Select an MPP File" SelectedFile = Application.GetOpenFilename(Filter, , Caption) If SelectedFile <> False Then Set objReader = CreateObject("ProjectReader.Application") Sheets.Add ActiveSheet.Name = "MicrosoftProjectResourceList" indexRow = 1 'OPEN THE PROJECT Call objReader.openFile(CStr(SelectedFile)) If Err.Number = 0 Then Set objProject = objReader.Project Range("A1:B6").Interior.Color = vbCyan Cells(indexRow, 1) = "Project Name" Cells(indexRow, 2) = objProject.Name indexRow = indexRow + 1 Cells(indexRow, 1) = "Project Author" Cells(indexRow, 2) = objProject.Author indexRow = indexRow + 1 Cells(indexRow, 1) = "Currency Symbol" Cells(indexRow, 2) = objProject.CurrencySymbol indexRow = indexRow + 1 Cells(indexRow, 1) = "Days Per Month" Cells(indexRow, 2) = objProject.DaysPerMonth indexRow = indexRow + 1 Cells(indexRow, 1) = "Minutes Per Week" Cells(indexRow, 2) = objProject.MinutesPerWeek indexRow = indexRow + 1 Cells(indexRow, 1) = "Minutes Per Day" Cells(indexRow, 2) = objProject.MinutesPerDay indexRow = indexRow + 2 countResource = objReader.Project.Resources.Count Range("B" & indexRow & ":R" & indexRow).Interior.Color = RGB(255, 150, 100) Cells(indexRow, 1) = "" Cells(indexRow, 2) = "Resource columns:" Cells(indexRow, 3) = "ID" Cells(indexRow, 4) = "Unique ID" Cells(indexRow, 5) = "Name" Cells(indexRow, 6) = "Initials" Cells(indexRow, 7) = "Work" Cells(indexRow, 8) = "Actual Work" Cells(indexRow, 9) = "Overtime Work" Cells(indexRow, 10) = "Actual Overtime Work" Cells(indexRow, 11) = "Regular Work" Cells(indexRow, 12) = "Cost" Cells(indexRow, 13) = "Actual Cost" Cells(indexRow, 14) = "Overtime Cost" Cells(indexRow, 15) = "Actual Overtime Cost" Cells(indexRow, 16) = "Cost Per Use" Cells(indexRow, 17) = "Max Units" Cells(indexRow, 18) = "Standard Rate" 'LOOP FOR EACH RESOURCE, RESOURCES ARE SORTED BY ID For indexResource = 1 To countResource Set objResource = objReader.Project.Resources.Item(indexResource) indexRow = indexRow + 1 Range("B" & indexRow & ":B" & indexRow).Interior.Color = RGB(255, 150, 100) Cells(indexRow, 1) = "" Cells(indexRow, 2) = "Resource -->" Cells(indexRow, 3) = objResource.ID Cells(indexRow, 4) = objResource.UniqueID Cells(indexRow, 5) = objResource.Name Cells(indexRow, 6) = objResource.Initials Cells(indexRow, 7) = objResource.Work Cells(indexRow, 8) = objResource.ActualWork Cells(indexRow, 9) = objResource.OvertimeWork Cells(indexRow, 10) = objResource.ActualOvertimeWork Cells(indexRow, 11) = objResource.RegularWork Cells(indexRow, 12) = objResource.Cost Cells(indexRow, 13) = objResource.ActualCost Cells(indexRow, 14) = objResource.OvertimeCost Cells(indexRow, 15) = objResource.ActualOvertimeCost Cells(indexRow, 16) = objResource.CostPerUse Cells(indexRow, 17) = objResource.MaxUnits Cells(indexRow, 18) = objResource.StandardRate Next Set objResource = Nothing Else MsgBox Err.Description End If Set objReader = Nothing End If End Sub Sub ProjectReaderChartSample() Dim objReader As Object Dim objProject As Object Dim objTask As Object Dim countTask As Long Dim indexTask As Long Dim indexRow As Long Dim Filter As String Dim Caption As String Dim SelectedFile As Variant Dim sheetName As String Dim chtChart As Chart On Error Resume Next Err.Clear Filter = "MPP files (*.mpp),*.mpp" Caption = "Please Select an MPP File" SelectedFile = Application.GetOpenFilename(Filter, , Caption) If SelectedFile <> False Then Set objReader = CreateObject("ProjectReader.Application") If Err.Number = 0 Then indexRow = 1 'OPEN THE PROJECT Call objReader.openFile(CStr(SelectedFile)) If Err.Number = 0 Then Set objProject = objReader.Project sheetName = "Project" & "-data" Sheets.Add ActiveSheet.Name = sheetName Cells(indexRow, 1) = "" Cells(indexRow, 2) = "Task" Cells(indexRow, 3) = "Work" Cells(indexRow, 4) = "Actual Work" countTask = objReader.Project.Tasks.Count 'LOOP FOR EACH TASK, TASKS ARE SORTED BY ID For indexTask = 1 To countTask Set objTask = objReader.Project.Tasks.Item(indexTask) If objTask.Summary = False And objTask.Subproject = False Then indexRow = indexRow + 1 Cells(indexRow, 1) = "" Cells(indexRow, 2) = objTask.Name Cells(indexRow, 3) = objTask.Work / 60 Cells(indexRow, 4) = objTask.ActualWork / 60 Set objTask = Nothing End If Next ' CREATE THE CHART Set chtChart = Charts.Add With chtChart .Name = "Project" & "-chart" .ChartType = xlColumnClustered .SetSourceData Source:=Sheets(sheetName).Range("B1:D" & indexRow), _ PlotBy:=xlColGroups .HasTitle = True .ChartTitle.Text = "Work - Actual Work" .Axes(xlCategory, xlPrimary).HasTitle = True .Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "Tasks" .Axes(xlValue, xlPrimary).HasTitle = True .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Work (hours)" End With ActiveWorkbook.Save Else MsgBox Err.Description End If Else MsgBox Err.Description End If Set objReader = Nothing End If End Sub