After searching for something to do this without luck, I wrote some VBA
to export assignment data to Excel. Here is a snippet of code I wrote
to export the assignment information to Excel. Make sure a reference is
added to the Microsoft Scripting Runtime and the Micrososft Excel Object
Library.
I stripped out a bunch of Excel formatting code and haven't tested
below to ensure it works exactly as listed but it should be very close.
At a minimum, you should be able to see how the export works.
Darryl
-----------------
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
