none
exporting Project to Excel RRS feed

  • Question

  • I have an VBA code that opens a project file copies the file name and task fields and closes the application and moves on to the next mpp. Everytime I compile the code I keep getting an user-defined type error along the Dim aMSP  As MSProject.Application.

    The code works for project 2007 but it does not work for a later version of project, any ideas?

    Sub PlanConsolidation()
    '______________________
    Dim aMSP  As MSProject.Application
    Dim prj As Project
    Dim tsk As Task
    '_____________________
    Dim FlList, Tgt As Worksheet
    Dim Pth, flnm As String
    Dim Index, rws, ans, i As Integer
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Set Tgt = ThisWorkbook.Worksheets("Data")
    'Get all filenames and place in this workbook active sheet
    '_________________________________________________________
    Pth = "C:\Users\Preetam\Desktop\Current Plans\"
    Set FlList = ThisWorkbook.Worksheets("Data")
    Index = 3
    'Clear all previous entries
    FlList.Activate
    FlList.Range("A2:a50").Select
    Selection.ClearContents
    FlList.Range("A2:A50").Select
    'Clear all records in the data tab
    Tgt.Activate
    Tgt.Range("b2:W3000").Select
    Selection.ClearContents
    Tgt.Range("A2:A2").Select

    flnm = Dir(Pth & "*.mpp")
    FlList.Cells(2, 1).Value = flnm
    Do Until flnm = ""
        flnm = Dir
        FlList.Cells(Index, 1).Value = flnm
        Index = Index + 1
    Loop
    Index = 2
    'Get number of files to process
    rws = FlList.UsedRange.Rows.Count
    'Load MSP
    Set aMSP = New MSProject.Application
    aMSP.Visible = True
    'Open each file in turn and return Level 0 milestone details for non tracking
    For i = 2 To rws
        If FlList.Cells(i, 1) = vbNullString Then GoTo NextFile
        ans = FileOpen(Pth & FlList.Cells(i, 1).Value, True, , , , , , , , , , , "PAssWord1")
           
            ' Catch the situation where we don't open a file
            ' If aMSP.ActiveProject Is Nothing Then GoTo NextFile
           
            Set prj = aMSP.ActiveProject
           
            Application.StatusBar = "Extracting from : " & prj.Name
           
            For Each tsk In prj.Tasks
               
               
                If Not tsk Is Nothing Then
                    If Not tsk.Summary Then
                        If tsk.Number1 = 0 Or tsk.Number1 = 1 Or tsk.Number1 = 2 Or tsk.Number1 = 3 Then
                           Tgt.Cells(Index, 2).Value = tsk.Milestone 'Milestone
                            Tgt.Cells(Index, 3).Value = prj.Name 'Project Name
                            Tgt.Cells(Index, 4).Value = tsk.Text1
                            Tgt.Cells(Index, 5).Value = tsk.Text12
                            Tgt.Cells(Index, 6).Value = tsk.Text25
                            Tgt.Cells(Index, 7).Value = tsk.Text30
                            Tgt.Cells(Index, 8).Value = tsk.Text11
                            Tgt.Cells(Index, 9).Value = tsk.Text10
                            Tgt.Cells(Index, 10).Value = tsk.OutlineCode6
                            Tgt.Cells(Index, 11).Value = tsk.Text3
                            Tgt.Cells(Index, 12).Value = tsk.Text2
                            Tgt.Cells(Index, 13).Value = tsk.Number1
                            Tgt.Cells(Index, 14).Value = tsk.Name
                            Tgt.Cells(Index, 15).Value = tsk.Text21
                            Tgt.Cells(Index, 16).Value = tsk.Text24
                            Tgt.Cells(Index, 17).Value = tsk.Text22
                            Tgt.Cells(Index, 18).Value = Format(tsk.BaselineFinish, "dd-MMM-yy")
                            Tgt.Cells(Index, 19).Value = Format(tsk.ActualFinish, "dd-MMM-yy")
                            Tgt.Cells(Index, 20).Value = Format(tsk.Finish, "dd-MMM-yy")
                            Tgt.Cells(Index, 21).Value = tsk.Text14
                            Tgt.Cells(Index, 22).Value = tsk.Text15
                            Tgt.Cells(Index, 23).Value = tsk.Text16
                            Tgt.Cells(Index, 24).Value = tsk.Text23
                            Tgt.Cells(Index, 25).Value = tsk.Flag18
                            Tgt.Cells(Index, 26).Value = tsk.Flag19
                            Tgt.Cells(Index, 27).Value = tsk.Flag20
                            Tgt.Cells(Index, 28).Value = tsk.Text26
                            Tgt.Cells(Index, 29).Value = tsk.Text17
                      
                         
                             Index = Index + 1
                        End If
                     End If
                  End If
            Next tsk
        aMSP.FileCloseEx pjDoNotSave
        Set prj = Nothing
        'aMSP.FileExit (pjDoNotSave)                     'Close MSP application
       
       
    NextFile:
    Next i
    Set aMSP = Nothing
    Application.StatusBar = False
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    msg "Export Complete"
    End Sub

    Wednesday, June 29, 2016 4:31 PM

All replies

  • I wouldn't expect this code to work for Project 2007 either. Take the following code:

    Dim aMSP  As MSProject.Application
     Dim prj As Project
     Dim tsk As Task
     '_____________________
    Dim FlList, Tgt As Worksheet

    If this code runs in Project VBA then you need a reference to Excel and the code should be:

    Dim aMSP  As MSProject.Application
     Dim prj As Project
     Dim tsk As Task
     '_____________________
    Dim FlList as Excel.Worksheet , Tgt As Excel.Worksheet

    If this code runs in Excel VBA the code should be:

    Dim aMSP  As MSProject.Application
     Dim prj As MSProject.Project
     Dim tsk As MSProject.Task
     '_____________________
    Dim FlList as Worksheet, Tgt As Worksheet
    There may then be follow up bugs but nothing should work until your Dims are correct.


    Rod Gill
    Author of the one and only Project VBA Book
    www.project-systems.co.nz

    Wednesday, June 29, 2016 10:15 PM
    Moderator