none
Export schedules from multiple projects to excel via VBA RRS feed

  • Question

  • Hey community,

    I got a tasked assigned during my internship as a final project
    I want to code a macro in Excel, that loads multiple MS Project files and their schedules into Excel.
    I would need the following columns to be exported from MS Project:

    • Task name
    • Start and Finish Date
    • Milestone (Yes/No)

    all the MS Project files would be in one folder including the Excel master sheet.
    Thank you guys for your help in advance.

    By the way:

    I have so far a macro that loads in the, manually exported Excel files for these Projects, but since we have 10 program managers with various projects, that process would be way to time consuming.

    Sub Transfer()
    Dim FolderPath As String, FilePath As String, FileName As String
    Dim erow As Long, lastrow As Long, lastcol As Long, r As Long
    Dim wb As Workbook, wb2 As Workbook, ws2 As Worksheet
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Set wb2 = Workbooks("MainFile.xlsm")
    Set ws2 = wb2.Sheets("Counter")
    FolderPath = "C:\Users\m0050424\Desktop\Makro\"
    FilePath = FolderPath & "*.xlsx*"
    FileName = Dir(FilePath)
    Do While Len(FileName) > 0
        Set wb = Workbooks.Open(FolderPath & FileName)
        wb.Sheets("Task_Table").Activate
        With ActiveSheet
            lastrow = .Cells(Rows.Count, 1).End(xlUp).Row
            lastcol = .Cells(1, Columns.Count).End(xlToLeft).Column
            For r = 2 To lastrow
                erow = ws2.Range("A" & Rows.Count).End(xlUp).Row + 1
                .Range("A" & r & ":P" & r).Copy Destination:=ws2.Range("B" & erow) 'Change P to the last column in your Counter sheets
                ws2.Range("A" & erow) = FileName
            Next r
        End With
        Application.CutCopyMode = False
        wb.Close savechanges:=False
        FileName = Dir
    Loop
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    End Sub
    

    Friday, July 21, 2017 7:07 PM

All replies

  • Export...

    You say you are an intern so I have to ask, are you looking for someone to write the complete macro for you or (hopefully), are you just looking for some guidance?

    Just for reference there are two methods for writing VBA, one is to write (or record) code that uses foreground processing and the other is to write code that uses background processing. So what's the difference? Foreground processing operates on the active view and generally runs slower. It's the type of code generated when a user records a macro. Background processing accesses the application objects directly, independent of view and doesn't necessarily require the source document to even be open. Background processing is more efficient and runs faster.

    John

    Friday, July 21, 2017 8:36 PM
  • Hey John,

    I would need some guidance, especially in pulling the data from my multiple timelines in MS Project.I want to process the code in the background. Is it even possible to code such a macro in Excel?

    Thanks for your help.

    Monday, August 7, 2017 5:03 PM
  • Do you have a name other than "Export schedule from multiple Project to Excel VBA"? It's just a little easier working with a person than with a subject matter.

    To answer your question, yes it is very possible to write a macro in Excel to do what you want. And the fact that all files, Project and Excel, are in a common folder makes it pretty straightforward.

    You said you wanted some guidance (rather than a full up macro) so let's take this approach. Here is a starting point. Expand upon it to complete your needs.

    Sub TestProjOpen()
    Dim prj As Object
    Dim FileNam As String
    Dim t As Task
    Dim TskNam As String, TskSt As Date, TskFi As Date
    Dim TskMil As Boolean
    On Error Resume Next
    'loop through all Project files in the folder
    FileNam = "C:\Users\John\Desktop\aaatest1.mpp"  'configure for your file names
    While FileNam <> ""
        Set prj = GetObject(FileNam)
        If Err <> 0 Then
            On Error GoTo 0
            Set prj = CreateObject("MSProject.Application")
            prj.Visible = True
            If Err <> 0 Then
                MsgBox "MS Project is not available on this workstation" _
                    & vbCr & "Install Project or check network connection", vbCritical, _
                    "Excel to Project - Fatal Error"
                FilterApply Name:="all tasks"
                Set prj = Nothing
                On Error GoTo 0     'clear error function
                Exit Sub
            End If
        End If
        'extract data from current project file using this loop structure
        For Each t In prj.Tasks
            If Not t Is Nothing Then
                'capture task name
                TskNam = t.Name
                TskSt = t.Start
                TskFi = t.Finish
                TskMil = t.Milestone
                'now dump those values into Excel worksheet
            End If
        Next t
        'increment to next Project filenam
        On Error GoTo 0
    Wend
    Set prj = Nothing
    End Sub

    Hope this helps.

    John




    • Edited by John - Project Tuesday, August 8, 2017 1:07 PM declarations
    Tuesday, August 8, 2017 2:31 AM