PDA

View Full Version : Copy Task Start and Finish to Excel



rrenis
12-08-2008, 02:28 PM
Hi - I'm trying to copy the dates for a series of identical tasks within several mpp files into an excel sheet. I have now hit a wall and I'm wondering whether what I am trying to achieve is possible. :dunno

I want the code to copy the corresponding start and finish date (based on the text in the Task Name column from the mpp file to the corresponding column in excel - which is named the same as the Task Name in the mpp file - except that either 'Start' or 'Finish' is appended to the Task Name.

Example mpp file data:

Task Name | Start Date | Finish Date
Task No1 | 01/12/2008 | 10/12/2008
Task No2 | 09/01/2009 | 20/01/2009
Task No3 | 08/02/2009 | 19/02/2009
etc...

Example xls file following copied data:

Ref | Task No1 Start | Task No1 Finish | Task No2 Start | Task No2 Finish etc...
123 | 01/12/2008 | 10/12/2008 | 09/01/2009 | 20/01/2009 | etc...

The Ref inserted into the excel file will be taken from the first few characters of the mpp filename.

Has anyone had any luck trying to do something similar or does this sound too ambitious? I'd really appreciate any advice or sample code that anyone can suggest as I'm at a loss. :bow:

Thanks for looking.

cheers,
rrenis

KeithRoberts
12-09-2008, 08:05 AM
I think that you will run into a problem with the format that you are choosing. MS Excel 2003 and below only allows 256 columns. Based on what you laying out, you will only be able to add 177 tasks (1 for ref name) and two columns per task for start and finish dates. MS Excel 2007 will allow you to use 16384, which allows you to have 8,191 tasks in the format that you listed. That being said, here is some code as a start:



Option Explicit
Dim xlRow As Excel.Range
Dim xlCol As Excel.Range
Sub CreateTaskList()
Dim fso As New FileSystemObject
Dim xlApp As Object
Dim xlbook As Object
Dim xlWorkSheet As Object
Dim tsk As Task
Dim Tsks As Tasks
Dim sRef As String
'Create the excel application object
Set xlApp = CreateObject("excel.application")
'Set to true to avoid the display of the sheet being filled in
xlApp.Visible = False
'AppActivate "Microsoft Excel"
xlApp.ScreenUpdating = False
'Create the workbook - creates sheets 1, 2, & 3
Set xlbook = xlApp.Workbooks.Add
'Create a new sheet
Set xlsheet = xlbook.Worksheets.Add
xlsheet.Name = "Tasks"
'Do not allow alert messages to be displayed
xlApp.DisplayAlerts = False
If fso.FileExists("C:\filename.xls") Then

fso.DeleteFile ("C:\filename.xls")

End If

xlbook.SaveAs FileName:="C:\filename.xls", _
FileFormat:=xlNormal, _
Password:="", _
WriteResPassword:="", _
ReadOnlyRecommended:=False, _
CreateBackup:=False

'Set Range to write to first cell
Set xlRow = xlApp.ActiveCell
xlRow = "Filename: " & ActiveProject.Name
dwn 1
xlRow = "Tasks"
dwn 1

'Save the project name ref
sRef = Left(ActiveProject.Name, 3)
Set Tsks = ActiveProject.Tasks
For each tsk in Tsks
If not tsk is Nothing Then
Set xlCol = xlRow.Offset(0, 0)
xlCol = sRef
rgt 1
xlCol = tsk.Name
rgt 1
xlCol = tsk.Start & " Start"
rgt 1
xlCol = tsk.Finish & " Finish"
dwn 1
End If
Next tsk
End Sub
Sub dwn(i As Integer)
Set xlRow = xlRow.Offset(i, 0)
End Sub
Sub rgt(i As Integer)
Set xlCol = xlCol.Offset(0, i)
End Sub


You could simply export the data using the save as function. Create a custom field that concatenates the word

rrenis
12-10-2008, 06:35 AM
Hi Keith - many thanks for your reply.
:beerchug:
I'm running Excel 20003 so luckily I only envisage 40 or so tasks so the column restriction shouldn't pose a problem for me as it stands.

Thanks for the code this looks like it will do pretty much what I'm after. I've tried running the code and unfortunately when I try to open the filename.xls spreadheet in C:\ excel hangs during the open process and I have to shut it down. When I then try to re-open filename.xls it opens fine although the 'Tasks' sheet is empty. The code has definitely finished running when I try to open the sheet. Also for info i've added references to Microsoft Scripting Runtime and Microsoft Excel 11 Object Library.

Do you know from these symptoms what I'm doing wrong? :help

Thanks again for taking the time to reply! :bow:

Cheers,
rrenis.

rrenis
12-10-2008, 03:06 PM
Hi Keith - thanks again for posting your code. I've had chance to have a proper look at it now and managed to get it working OK by adding xlbook.save to the end of the code and also set fso and xlapp to nothing to stop excel from hanging.

I didn't explain it too well previously as I was trying to contain all of the data from the mpp file in 1 row within excel. Hopefully the following illustrates this better...

All of the following to be contained on 1 row:

Column A = Reference (obtained from first few characters of filename)
Column B = Task 1 Start Date
Column C = Task 1 Finish Date
Column D = Task 2 Start Date
Column E = Task 2 Finish Date
Column F = Task 3 Start Date
Column G = Task 3 Finish Date
etc...

I was hoping to have Row 1 as the header (the column header will be identical to the corresponding task but appended by either start or finish). Ideally I would like to use some kind of text compare to verify that the data is going in the right place.

The code you've provided so far is great as it gives me something to work on. I'd appreciate any advice as to whether you feel what I've outlined above is a step too far or a real possibility (I've taught myself VBA from googling and reading through this site so I have some sizable gaps in my knowledge! :doh:).

Thanks again for your code :bow:

cheers,
rrenis

rrenis
12-10-2008, 03:28 PM
Hi Keith - sorry shouldn't have posted so soon - managed to figure out how to contain it all on one row by tweaking your code. Just need to work on the text compare and I think I'll be there!! I've still got the problem where excel remains in the task manager process list when the code finishes running though - not too sure why - I thought setting xlapp to nothing would have cured that, presumably it's to do with the global dim for excel.range?

Thanks again for your code - I'd have never got there by myself. :cloud9:
:beerchug:

cheers,
rrenis