Issue Pulling data from MS Project files

T

tlahowetz

New Member
Joined
Dec 20, 2018
Messages
3
Hi:
I have developed (and re-used) some Excel macros to pull task data from MS Project (.mpp) files. The issue I have is that the routines I have will only pull the data if the column I seek is inserted into the gantt chart view.
Is there a way (with a VBA macro) to check and see I the column is in the view and if not, add it?
 

Excel Facts

Spell Check in Excel
Press F7 to start spell check in Excel. Be careful, by default, Excel does not check Capitalized Werds (whoops)
Sort by date Sort by votes
Re: Issue Pulloing data from MS Project files

In the macros I have written for Project, I refer to various Task attributes and it doesn't matter if they are displayed in a Gantt chart view.

Can you show the current code you are using to pull task data? If your code is referring to the view (which I haven't done) then it might be better to rewrite it to refer to Task attributes.
 
Upvote 0
Re: Issue Pulloing data from MS Project files

6StringJazzer said:
In the macros I have written for Project, I refer to various Task attributes and it doesn't matter if they are displayed in a Gantt chart view.

Can you show the current code you are using to pull task data? If your code is referring to the view (which I haven't done) then it might be better to rewrite it to refer to Task attributes.
Click to expand...

Code: 
 Sub OpenProjectCopyPasteData(MPPpathname As String)
Dim appProj As MSProject.Application
Dim aProg As MSProject.Project
Dim sel As MSProject.Selection
Dim ts As Tasks
Dim t As Task
Dim rng As Range
Dim ws As Worksheet
Dim WSName As String
Dim i As Integer
Application.DisplayAlerts = False
'
' Excel Set up to access MS Project
'
On Error Resume Next
Set appProj = GetObject(, "MSProject.Application")
If appProj Is Nothing Then
    Set appProj = New MSProject.Application
End If
appProj.Visible = True
'
'Open MS Project file
'
'MsgBox "debug-OPEN:" & MPPpathname & "<"
appProj.Application.FileOpenEx MPPpathname, ReadOnly:=True
Set appProj = appProj.ActiveProject
'
'Final set up of code
'
Set projApp = Nothing
'Set aProg = appProj.Projects(MPPpathname)
appProj.Visible = True
WindowActivate WindowName:=aProg
'
' get next available project worksheet name and create the worksheet
'
'Add New Sheet
     i = 0
     Sheets.Add
'
'Keep looking for new name if name is in use
'
    Do Until err.Number = 0
        i = i + 1
        WSName = "Project" & i
        err.Clear
        ActiveSheet.Name = WSName
    Loop
    
    Set ws = Worksheets(WSName)
'
'Copy the project columns and paste into Excel
'
Set ts = appProg.Tasks
SelectTaskColumn Column:="Project"
OutlineShowAllTasks
OutlineShowAllTasks
EditCopy
Set rng = ws.Range("A:A")
ActiveSheet.Paste Destination:=rng
SelectTaskColumn Column:="WBS"
EditCopy
Set rng = ws.Range("B:B")
ActiveSheet.Paste Destination:=rng
SelectTaskColumn Column:="Name"
EditCopy
Set rng = ws.Range("C:C")
ActiveSheet.Paste Destination:=rng
SelectTaskColumn Column:="Resource Names"
EditCopy
Set rng = ws.Range("D:D")
ActiveSheet.Paste Destination:=rng
SelectTaskColumn Column:="Duration"
EditCopy
Set rng = ws.Range("E:E")
ActiveSheet.Paste Destination:=rng
SelectTaskColumn Column:="Start"
EditCopy
Set rng = ws.Range("F:F")
ActiveSheet.Paste Destination:=rng
SelectTaskColumn Column:="Finish"
EditCopy
Set rng = ws.Range("G:G")
ActiveSheet.Paste Destination:=rng
SelectTaskColumn Column:="Baseline Start"
EditCopy
Set rng = ws.Range("H:H")
ActiveSheet.Paste Destination:=rng

SelectTaskColumn Column:="Baseline Finish"
EditCopy
Set rng = ws.Range("I:I")
ActiveSheet.Paste Destination:=rng
SelectTaskColumn Column:="Actual Start"
EditCopy
Set rng = ws.Range("J:J")
ActiveSheet.Paste Destination:=rng
SelectTaskColumn Column:="Actual Finish"
EditCopy
Set rng = ws.Range("K:K")
ActiveSheet.Paste Destination:=rng
SelectTaskColumn Column:="% Complete"
EditCopy
Set rng = ws.Range("L:L")
ActiveSheet.Paste Destination:=rng
Application.DisplayAlerts = True
appProj.DisplayAlerts = True
'
'close the project file
'
appProj.Application.ActiveProject.Close savechanges:=False
appProj.Quit
End Sub
 
Upvote 0
Re: Issue Pulloing data from MS Project files

tlahowetz said:
Code: 
 Sub OpenProjectCopyPasteData(MPPpathname As String)
Dim appProj As MSProject.Application
Dim aProg As MSProject.Project
Dim sel As MSProject.Selection
Dim ts As Tasks
Dim t As Task
Dim rng As Range
Dim ws As Worksheet
Dim WSName As String
Dim i As Integer
Application.DisplayAlerts = False
'
' Excel Set up to access MS Project
'
On Error Resume Next
Set appProj = GetObject(, "MSProject.Application")
If appProj Is Nothing Then
    Set appProj = New MSProject.Application
End If
appProj.Visible = True
'
'Open MS Project file
'
'MsgBox "debug-OPEN:" & MPPpathname & "<"
appProj.Application.FileOpenEx MPPpathname, ReadOnly:=True
Set appProj = appProj.ActiveProject
'
'Final set up of code
'
Set projApp = Nothing
'Set aProg = appProj.Projects(MPPpathname)
appProj.Visible = True
WindowActivate WindowName:=aProg
'
' get next available project worksheet name and create the worksheet
'
'Add New Sheet
     i = 0
     Sheets.Add
'
'Keep looking for new name if name is in use
'
    Do Until err.Number = 0
        i = i + 1
        WSName = "Project" & i
        err.Clear
        ActiveSheet.Name = WSName
    Loop
    
    Set ws = Worksheets(WSName)
'
'Copy the project columns and paste into Excel
'
Set ts = appProg.Tasks
SelectTaskColumn Column:="Project"
OutlineShowAllTasks
OutlineShowAllTasks
EditCopy
Set rng = ws.Range("A:A")
ActiveSheet.Paste Destination:=rng
SelectTaskColumn Column:="WBS"
EditCopy
Set rng = ws.Range("B:B")
ActiveSheet.Paste Destination:=rng
SelectTaskColumn Column:="Name"
EditCopy
Set rng = ws.Range("C:C")
ActiveSheet.Paste Destination:=rng
SelectTaskColumn Column:="Resource Names"
EditCopy
Set rng = ws.Range("D:D")
ActiveSheet.Paste Destination:=rng
SelectTaskColumn Column:="Duration"
EditCopy
Set rng = ws.Range("E:E")
ActiveSheet.Paste Destination:=rng
SelectTaskColumn Column:="Start"
EditCopy
Set rng = ws.Range("F:F")
ActiveSheet.Paste Destination:=rng
SelectTaskColumn Column:="Finish"
EditCopy
Set rng = ws.Range("G:G")
ActiveSheet.Paste Destination:=rng
SelectTaskColumn Column:="Baseline Start"
EditCopy
Set rng = ws.Range("H:H")
ActiveSheet.Paste Destination:=rng

SelectTaskColumn Column:="Baseline Finish"
EditCopy
Set rng = ws.Range("I:I")
ActiveSheet.Paste Destination:=rng
SelectTaskColumn Column:="Actual Start"
EditCopy
Set rng = ws.Range("J:J")
ActiveSheet.Paste Destination:=rng
SelectTaskColumn Column:="Actual Finish"
EditCopy
Set rng = ws.Range("K:K")
ActiveSheet.Paste Destination:=rng
SelectTaskColumn Column:="% Complete"
EditCopy
Set rng = ws.Range("L:L")
ActiveSheet.Paste Destination:=rng
Application.DisplayAlerts = True
appProj.DisplayAlerts = True
'
'close the project file
'
appProj.Application.ActiveProject.Close savechanges:=False
appProj.Quit
End Sub
Click to expand...

what I find is that if a column is not inserted in view that the previous column is duplicated.

[TABLE="width: 528"]
[TR]
[TD="width: 64, bgcolor: #DFE3E8"]WBS[/TD]
[TD="width: 64, bgcolor: #DFE3E8"]Deliverable Name, Task Name[/TD]
[TD="width: 64, bgcolor: #DFE3E8"]Resource Names[/TD]
[TD="width: 64, bgcolor: #DFE3E8"]Duration[/TD]
[TD="width: 64, bgcolor: #DFE3E8"]Start[/TD]
[TD="width: 64, bgcolor: #DFE3E8"]Finish[/TD]
[TD="width: 64, bgcolor: #DFE3E8"]Finish[/TD]
[TD="width: 64, bgcolor: #DFE3E8"]Finish[/TD]
[TD="width: 64, bgcolor: #DFE3E8"]Finish[/TD]
[TD="width: 64, bgcolor: #DFE3E8"]Finish[/TD]
[TD="width: 64, bgcolor: #DFE3E8"]% Complete[/TD]
[/TR]
[TR]
[TD="width: 64, bgcolor: white, align: right"]0[/TD]
[TD="width: 64, bgcolor: white"]LO ETO 36518 Simply SHP-FTP Migration to Axway [/TD]
[TD="width: 64, bgcolor: white"] [/TD]
[TD="width: 64, bgcolor: white"]594 days?[/TD]
[TD="width: 64, bgcolor: white"]Thu 9/22/16[/TD]
[TD="width: 64, bgcolor: white"]Fri 1/25/19[/TD]
[TD="width: 64, bgcolor: white"]Fri 1/25/19[/TD]
[TD="width: 64, bgcolor: white"]Fri 1/25/19[/TD]
[TD="width: 64, bgcolor: white"]Fri 1/25/19[/TD]
[TD="width: 64, bgcolor: white"]Fri 1/25/19[/TD]
[TD="width: 64, bgcolor: white, align: right"]51%[/TD]
[/TR]
[TR]
[TD="width: 64, bgcolor: white, align: right"]1[/TD]
[TD="width: 64, bgcolor: white"] Initiation Complete (Includes prerequisites)[/TD]
[TD="width: 64, bgcolor: white"] [/TD]
[TD="width: 64, bgcolor: white"]93 days[/TD]
[TD="width: 64, bgcolor: white"]Mon 5/14/18[/TD]
[TD="width: 64, bgcolor: white"]Mon 9/24/18[/TD]
[TD="width: 64, bgcolor: white"]Mon 9/24/18[/TD]
[TD="width: 64, bgcolor: white"]Mon 9/24/18[/TD]
[TD="width: 64, bgcolor: white"]Mon 9/24/18[/TD]
[TD="width: 64, bgcolor: white"]Mon 9/24/18[/TD]
[TD="width: 64, bgcolor: white, align: right"]88%[/TD]
[/TR]
[/TABLE]
 
Upvote 0
Re: Issue Pulloing data from MS Project files

Here is an alternative way to do this. This is a tool that extracts a Project file into Excel, with a lot of configuration for what you want to extract. See if this is useful. If not, then I will if it's possible to modify your code for what you want.
 
Upvote 0
You must log in or register to reply here.

Similar threads

N
  • Question Question
MS EXCEL macros/VBA migration to new tool.
Replies
2
Views
353
RoryA
RoryA
C
  • Solved
Running VBA macros for Excel via .bat file
Replies
3
Views
476
Micron
M
S
  • Question Question
VBA code to update/refresh a mail merge in word
Replies
0
Views
866
StephenBart
S
S
  • Solved
Display the text before the 6th instance of a period in a string (MS Project or VBA)
2
Replies
11
Views
1K
johnnyL
J
H
  • Question Question
Excel to Word table creation - formatting issue
Replies
0
Views
402
hannerz78
H

Forum statistics

Threads
1,223,721
Messages
6,174,096
Members
452,542
Latest member
Bricklin

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top