Hi
I have a routine which prints individual task lists from a Project Plan using VBA. This routine is currently being piloted and they have advised that not all resources have a task list produced. when I step through the code the Resource numbers appears in this order:
1,3,18,7,8,9,11,12,13,14,18,19,20,21,22,23,24,25
Task lists are produced for each of the above resources. However this misses resource numbers 2,4,5,6,10,15,16,17 and I have no idea why. I have supplied my code below. Any advice/guidance appreciated. You will note that the task lists are exported to a pre-defined spreadsheet template.
Sub PrintResourceCharts() Dim xlApp As Excel.Application Dim xlRange As Excel.Range Dim rName As String Dim Tsk As Task Dim Res As Resource Dim Ass As Assignment Dim s As Worksheet Dim BookNam As String Dim Row As Integer Dim fName As String 'Call SetSummaryTask - DB: commented out - run summaryname manually as required. Call Task_CF_To_Assignment_CF 'Remove Existing Task List files from directory before creating new ones On Error GoTo Finish Kill "D:\Task List Templates\Task Lists\*.*" Finish: 'Save File Location fName = "D:\Task List Templates\Task Lists\" 'Start Excel and Create a new Workbook Set xlApp = CreateObject("Excel.Application") xlApp.Visible = True 'Export Resource and Task details For Each Res In ActiveProject.Resources If Res.Assignments.Count > 0 Then Row = 5 xlApp.Workbooks.Open ("D:\Task List Templates\Task List Template.xlsm") BookNam = xlApp.ActiveWorkbook.Name Set s = xlApp.Workbooks(BookNam).Worksheets(1) For Each Ass In Res.Assignments Set xlRange = s.Range("A5") If Ass.PercentWorkComplete < 100 Then With xlRange rName = Ass.ResourceName s.Range("A" & Row).Value = Ass.ResourceName s.Range("B" & Row).Value = Ass.TaskUniqueID s.Range("D" & Row).Value = Ass.Text1 s.Range("E" & Row).Value = Ass.Start s.Range("G" & Row).Value = Ass.Finish End With End If Row = Row + 1 Set xlRange = xlRange.Offset(Row, 0) 'Point to next row Next xlApp.Visible = True Application.DisplayAlerts = False If rName = "" Then GoTo Finished End If xlApp.ActiveWorkbook.SaveAs FileName:= _"D:\Task List Templates\Task Lists\" & rName & ".xlsm", FileFormat:= _ xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False rName = "" xlApp.ActiveWorkbook.Close savechanges:=False Application.DisplayAlerts = True End If Next Finished: xlApp.Application.Quit Set xlApp = Nothing MsgBox ("Individual Task Lists have now been produced....") End Sub