N
Nathalie
Hi,
I found a code to export assignments to Excel.
it worked but the code is based on the active
project.
If I have five projects opened, I have a message error because I
have to
change of active project to keep on executing. I added the
project
name and the parent task. I would like
to see all
the assignments in all the projects. I have tried to modify a
little bit the
code but I'm stuck.
Could you give me any help?
Here below is the code:
Option Explicit
Const REPORTING_WINDOW As Integer = 14
Sub WriteTimePhasedData()
Dim oExcel As Excel.Application
Dim objFSO As FileSystemObject
Dim dstatusdate As Date
Dim strFN As String
Dim strDir As String
Dim a As Assignment
Dim TSV As TimeScaleValues
Dim r As Resource
Dim row As Integer
Dim col As Integer
Dim i As Integer
Dim ResIndex As Integer
Dim t As Task
' Use today's date if the status date in MSP is set to "NA" otherwise use
the status date.
dstatusdate = IIf(TypeName(ActiveProject.StatusDate) = "String", Now(),
ActiveProject.StatusDate)
' Create blank worksheet template
Set oExcel = New Excel.Application
oExcel.Workbooks.Add
oExcel.Visible = True
strDir = "c:\project reports\" & ActiveProject.Project & "\" &
Format(dstatusdate, "MM_DD_YY") & "\"
strFN = "MSP Timephased Export.xlsx"
Set objFSO = New FileSystemObject
MakeDir strDir
If objFSO.FileExists(strDir & strFN) Then
objFSO.DeleteFile strDir & strFN, True
End If
Set objFSO = Nothing
row = 1
col = 1
' Write header
oExcel.Cells(row, 1) = "Name"
oExcel.Cells(row, 2) = "Task"
oExcel.Cells(row, 3) = "Project Manager"
For i = 1 To REPORTING_WINDOW
oExcel.Cells(row, 3 + i) = " " & Format(Now() + i - 1, "MM/DD/YY")
Next
row = row + 1
' Generate reports for all resources.
For ResIndex = 1 To ActiveProject.ResourceCount
Set r = ActiveProject.Resources(ResIndex)
' Do this person have any tasks?
If r.Assignments.Count > 0 Then
' Generate the tasks for this resource.
For Each a In r.Assignments
Set TSV = a.TimeScaleData(Now(), Now() + REPORTING_WINDOW - 1,
pjAssignmentTimescaledWork, pjTimescaleDays)
oExcel.Cells(row, 1) = r.Name
oExcel.Cells(row, 2) = a.TaskName
Set t = ActiveProject.Tasks(a.TaskID)
oExcel.Cells(row, 3) = t.Text1
For i = 1 To TSV.Count
If (TSV.Item(i) <> "") Then
oExcel.Cells(row, 3 + i) = Round(TSV.Item(i) / 60, 1)
End If
Next
row = row + 1
Next
End If
Next
' Save and close workbook
oExcel.ActiveWorkbook.SaveAs strDir & strFN
oExcel.ActiveWorkbook.Close
MsgBox ("Export complete. File created " & strDir & strFN)
End Sub
' Recursively create the directory path provided in fldr
' May be used with UNC paths
Private Sub MakeDir(ByVal NewFolder As String)
Dim sPath() As String
Dim FSO As FileSystemObject
Dim sFolder As String
Dim i As Integer
Set FSO = CreateObject("Scripting.FileSystemObject")
sPath = Split(NewFolder, "\")
sFolder = sPath(0)
If Len(Replace(sFolder, ":", "")) = Len(sFolder) Then sFolder = "\\" & sFolder
For i = 1 To UBound(sPath)
sFolder = sFolder & "\" & sPath(i)
If Not FSO.FolderExists(sFolder) Then FSO.CreateFolder (sFolder)
Next
End Sub
I found a code to export assignments to Excel.
it worked but the code is based on the active
project.
If I have five projects opened, I have a message error because I
have to
change of active project to keep on executing. I added the
project
name and the parent task. I would like
to see all
the assignments in all the projects. I have tried to modify a
little bit the
code but I'm stuck.
Could you give me any help?
Here below is the code:
Option Explicit
Const REPORTING_WINDOW As Integer = 14
Sub WriteTimePhasedData()
Dim oExcel As Excel.Application
Dim objFSO As FileSystemObject
Dim dstatusdate As Date
Dim strFN As String
Dim strDir As String
Dim a As Assignment
Dim TSV As TimeScaleValues
Dim r As Resource
Dim row As Integer
Dim col As Integer
Dim i As Integer
Dim ResIndex As Integer
Dim t As Task
' Use today's date if the status date in MSP is set to "NA" otherwise use
the status date.
dstatusdate = IIf(TypeName(ActiveProject.StatusDate) = "String", Now(),
ActiveProject.StatusDate)
' Create blank worksheet template
Set oExcel = New Excel.Application
oExcel.Workbooks.Add
oExcel.Visible = True
strDir = "c:\project reports\" & ActiveProject.Project & "\" &
Format(dstatusdate, "MM_DD_YY") & "\"
strFN = "MSP Timephased Export.xlsx"
Set objFSO = New FileSystemObject
MakeDir strDir
If objFSO.FileExists(strDir & strFN) Then
objFSO.DeleteFile strDir & strFN, True
End If
Set objFSO = Nothing
row = 1
col = 1
' Write header
oExcel.Cells(row, 1) = "Name"
oExcel.Cells(row, 2) = "Task"
oExcel.Cells(row, 3) = "Project Manager"
For i = 1 To REPORTING_WINDOW
oExcel.Cells(row, 3 + i) = " " & Format(Now() + i - 1, "MM/DD/YY")
Next
row = row + 1
' Generate reports for all resources.
For ResIndex = 1 To ActiveProject.ResourceCount
Set r = ActiveProject.Resources(ResIndex)
' Do this person have any tasks?
If r.Assignments.Count > 0 Then
' Generate the tasks for this resource.
For Each a In r.Assignments
Set TSV = a.TimeScaleData(Now(), Now() + REPORTING_WINDOW - 1,
pjAssignmentTimescaledWork, pjTimescaleDays)
oExcel.Cells(row, 1) = r.Name
oExcel.Cells(row, 2) = a.TaskName
Set t = ActiveProject.Tasks(a.TaskID)
oExcel.Cells(row, 3) = t.Text1
For i = 1 To TSV.Count
If (TSV.Item(i) <> "") Then
oExcel.Cells(row, 3 + i) = Round(TSV.Item(i) / 60, 1)
End If
Next
row = row + 1
Next
End If
Next
' Save and close workbook
oExcel.ActiveWorkbook.SaveAs strDir & strFN
oExcel.ActiveWorkbook.Close
MsgBox ("Export complete. File created " & strDir & strFN)
End Sub
' Recursively create the directory path provided in fldr
' May be used with UNC paths
Private Sub MakeDir(ByVal NewFolder As String)
Dim sPath() As String
Dim FSO As FileSystemObject
Dim sFolder As String
Dim i As Integer
Set FSO = CreateObject("Scripting.FileSystemObject")
sPath = Split(NewFolder, "\")
sFolder = sPath(0)
If Len(Replace(sFolder, ":", "")) = Len(sFolder) Then sFolder = "\\" & sFolder
For i = 1 To UBound(sPath)
sFolder = sFolder & "\" & sPath(i)
If Not FSO.FolderExists(sFolder) Then FSO.CreateFolder (sFolder)
Next
End Sub