VBA Copy Paste Data into Excel from Project

问题

I'm running the code below and getting spurious results.

For some reason it copies five lines of code into the desired worksheet instead of the specified MS Project data.

Can Anyone help out a newbie?

Five lines of code incorrectly copied into Excel worksheet:

'Open MS Project file
projApp.Application.FileOpenEx "C:File.mpp"

Set projApp = projApp.ActiveProject

'Final set up of code
Set projApp = Nothing

Error Image

Sub OpenProjectCopyPasteData()

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

Application.DisplayAlerts = False

'Clear current contents

Set ws = Worksheets("Project Data")
Set rng = ws.Range("A:J")
rng.ClearContents

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
projApp.Application.FileOpenEx "C:File.mpp"
Set projApp = projApp.ActiveProject

'Final set up of code
Set projApp = Nothing

appProj.Visible = True

WindowActivate WindowName:=aProg

'Copy the project columns and paste into Excel
Set ts = aProg.Tasks

SelectTaskColumn Column:="Task Name"
OutlineShowAllTasks
OutlineShowAllTasks
EditCopy
Set ws = Worksheets("Project Data")
Set rng = ws.Range("A:A")
ActiveSheet.Paste Destination:=rng

SelectTaskColumn Column:="Task Name"
EditCopy
Set rng = ws.Range("B:B")
ActiveSheet.Paste Destination:=rng

SelectTaskColumn Column:="Resource Names"
EditCopy
Set rng = ws.Range("C:C")
ActiveSheet.Paste Destination:=rng

SelectTaskColumn Column:="Finish"
EditCopy
Set rng = ws.Range("D:D")
ActiveSheet.Paste Destination:=rng

Application.DisplayAlerts = True
appProj.DisplayAlerts = True

End Sub

回答1:

I am not sure how your original code above worked, since you Dim and Set the variable appProj, but later trying to open the MS-Project file with projApp.Application.FileOpenEx "C:File.mpp" (projApp <> appProj).

Try the code below (tested), it will copy the 3 columns ("Name" , "Resource Names" and "Finish") to worksheet "Project Data" at columns "A:C".

Code

Option Explicit

Sub OpenProjectCopyPasteData()

Dim PrjApp      As MSProject.Application
Dim aProg       As MSProject.Project
Dim PrjFullName As String
Dim t           As Task
Dim rng         As Range
Dim ws          As Worksheet

Application.ScreenUpdating = False
Application.DisplayAlerts = False

'Clear current contents
Set ws = Worksheets("Project Data")
Set rng = ws.Range("A:J")
rng.ClearContents

On Error Resume Next
Set PrjApp = GetObject(, "MSProject.Application")
If PrjApp Is Nothing Then
    Set PrjApp = New MSProject.Application
End If
On Error GoTo 0
PrjApp.ScreenUpdating = False
PrjApp.Visible = True

'Open MS Project file
PrjFullName = "C:File.mpp" '<-- keep the MS-Project file name and path in a variable
PrjApp.Application.FileOpenEx PrjFullName
Set aProg = PrjApp.ActiveProject

' show all tasks
OutlineShowAllTasks

'Copy the project columns and paste into Excel
SelectTaskColumn Column:="Name"
EditCopy
Set ws = Worksheets("Project Data")
Set rng = ws.Range("A:A")
rng.PasteSpecial xlPasteValues
rng.PasteSpecial xlPasteFormats

SelectTaskColumn Column:="Resource Names"
EditCopy
Set rng = ws.Range("B:B")
rng.PasteSpecial xlPasteValues
rng.PasteSpecial xlPasteFormats

SelectTaskColumn Column:="Finish"
EditCopy
Set rng = ws.Range("C:C")
rng.PasteSpecial xlPasteValues
rng.PasteSpecial xlPasteFormats

' reset settings of Excel and MS-Project
Application.DisplayAlerts = True
Application.ScreenUpdating = True
PrjApp.ScreenUpdating = True
PrjApp.DisplayAlerts = True

'PrjApp.FileClose False
PrjApp.Quit pjDoNotSave
Set PrjApp = Nothing

End Sub

来源：https://stackoverflow.com/questions/43882940/vba-copy-paste-data-into-excel-from-project

标签

excel

vba

ms-project