Hi All,
I've cobbled some code together from various sources as I'm a tinkerer not a seasoned coder. The code below is not pretty or efficient, I will work on that, but for now... I'd really appreciate your help.
My code works...ish
It opens a Microsoft Project file (MPP), copies three columns and pastes the data back into a worksheet ready for use. The file location and the name of the worksheet are pulled from cells in the workbook to avoid hard coding them. Unfortunately, I need to pull data in from more than one MPP file, and when the code runs again, it errors.
Please help me improve my code references to avoid the Run-Time 462 error
I have tried to fix this myself and believe I have the reason for the error from Microsoft knowledge base article 178510. Unfortunately, my lack of technical understanding means I am failing to translate that article into the changes needed to fix my code. I appreciate it is something to do with not specifying sufficient object details!?? But not sure what I need to do.
Your advice, commentary, help, would be warmly received.
Your humble servant,
Jim.
Sub Import_VTP()
Dim appProj As MSProject.Application
Dim appProj2 As MSProject.Application
Dim aProg As MSProject.Project
Dim aProg2 As MSProject.Project
Dim rng As Range
Dim rng2 As Range
Dim ws As Worksheet
Dim ws2 As Worksheet
Application.DisplayAlerts = False
'appProj.DisplayAlerts = False
'***Clear Contents of Columns in Each Worksheet Ready For New Data*******************************
Set ws = Worksheets(Range("C2").Value)
Set rng = ws.Range("A:C")
rng.ClearContents
Set ws2 = Worksheets(Range("C3").Value)
Set rng2 = ws2.Range("A:C")
rng2.ClearContents
Set ws3 = Worksheets(Range("C4").Value)
Set rng3 = ws3.Range("A:C")
rng3.ClearContents
'***OPEN COPY CLOSE MPP Document 1*****************************************
'***Open Project file*******************************
Set appProj = CreateObject("Msproject.Application")
appProj.FileOpen (Range("B2").Value)
Set aProg = appProj.ActiveProject
appProj.Visible = True
'***Copy Project file*******************************
'column1-Unique Identifier
SelectTaskColumn Column:="Text29"
OutlineShowAllTasks
OutlineShowAllTasks
EditCopy
Set ws = Worksheets(Range("C2").Value)
Set rng = ws.Range("A:A")
ActiveSheet.Paste Destination:=rng
'column2-Task Name
SelectTaskColumn Column:="Name"
EditCopy
Set rng = ws.Range("B:B")
ActiveSheet.Paste Destination:=rng
'column3-Finish Date
SelectTaskColumn Column:="Finish"
EditCopy
Set rng = ws.Range("C:C")
ActiveSheet.Paste Destination:=rng
'***Close Project file*******************************
appProj.FileClose pjDoNotSave
appProj.Quit
Set appProj = Nothing
'***OPEN COPY CLOSE MPP Document 2*****************************************
'***Open Project file*******************************
Set appProj2 = CreateObject("Msproject.Application")
appProj2.FileOpen (Range("B3").Value) 'opens file name from cell B3
Set aProg2 = appProj2.ActiveProject
appProj2.Visible = True
'***Copy Project file*******************************
'column1-UID
SelectTaskColumn Column:="Text29" 'ERRORS HERE with Run-Time Error 246
OutlineShowAllTasks
OutlineShowAllTasks
EditCopy
Set ws = Worksheets(Range("C3").Value)
Set rng = ws.Range("A:A")
ActiveSheet.Paste Destination:=rng
'column2-Task Name
SelectTaskColumn Column:="Name"
EditCopy
Set rng = ws.Range("B:B")
ActiveSheet.Paste Destination:=rng
'column3-Finish Date
SelectTaskColumn Column:="Finish"
EditCopy
Set rng = ws.Range("C:C")
ActiveSheet.Paste Destination:=rng
'***Close Project file*******************************
appProj2.FileClose pjDoNotSave
appProj2.Quit
Set appProj2 = Nothing
'third loop removed to reduce space on forum
AppActivate "Excel"
Application.DisplayAlerts = True
'appProj.DisplayAlerts = True
End Sub
I've cobbled some code together from various sources as I'm a tinkerer not a seasoned coder. The code below is not pretty or efficient, I will work on that, but for now... I'd really appreciate your help.
My code works...ish
It opens a Microsoft Project file (MPP), copies three columns and pastes the data back into a worksheet ready for use. The file location and the name of the worksheet are pulled from cells in the workbook to avoid hard coding them. Unfortunately, I need to pull data in from more than one MPP file, and when the code runs again, it errors.
Please help me improve my code references to avoid the Run-Time 462 error
I have tried to fix this myself and believe I have the reason for the error from Microsoft knowledge base article 178510. Unfortunately, my lack of technical understanding means I am failing to translate that article into the changes needed to fix my code. I appreciate it is something to do with not specifying sufficient object details!?? But not sure what I need to do.
Your advice, commentary, help, would be warmly received.
Your humble servant,
Jim.
Sub Import_VTP()
Dim appProj As MSProject.Application
Dim appProj2 As MSProject.Application
Dim aProg As MSProject.Project
Dim aProg2 As MSProject.Project
Dim rng As Range
Dim rng2 As Range
Dim ws As Worksheet
Dim ws2 As Worksheet
Application.DisplayAlerts = False
'appProj.DisplayAlerts = False
'***Clear Contents of Columns in Each Worksheet Ready For New Data*******************************
Set ws = Worksheets(Range("C2").Value)
Set rng = ws.Range("A:C")
rng.ClearContents
Set ws2 = Worksheets(Range("C3").Value)
Set rng2 = ws2.Range("A:C")
rng2.ClearContents
Set ws3 = Worksheets(Range("C4").Value)
Set rng3 = ws3.Range("A:C")
rng3.ClearContents
'***OPEN COPY CLOSE MPP Document 1*****************************************
'***Open Project file*******************************
Set appProj = CreateObject("Msproject.Application")
appProj.FileOpen (Range("B2").Value)
Set aProg = appProj.ActiveProject
appProj.Visible = True
'***Copy Project file*******************************
'column1-Unique Identifier
SelectTaskColumn Column:="Text29"
OutlineShowAllTasks
OutlineShowAllTasks
EditCopy
Set ws = Worksheets(Range("C2").Value)
Set rng = ws.Range("A:A")
ActiveSheet.Paste Destination:=rng
'column2-Task Name
SelectTaskColumn Column:="Name"
EditCopy
Set rng = ws.Range("B:B")
ActiveSheet.Paste Destination:=rng
'column3-Finish Date
SelectTaskColumn Column:="Finish"
EditCopy
Set rng = ws.Range("C:C")
ActiveSheet.Paste Destination:=rng
'***Close Project file*******************************
appProj.FileClose pjDoNotSave
appProj.Quit
Set appProj = Nothing
'***OPEN COPY CLOSE MPP Document 2*****************************************
'***Open Project file*******************************
Set appProj2 = CreateObject("Msproject.Application")
appProj2.FileOpen (Range("B3").Value) 'opens file name from cell B3
Set aProg2 = appProj2.ActiveProject
appProj2.Visible = True
'***Copy Project file*******************************
'column1-UID
SelectTaskColumn Column:="Text29" 'ERRORS HERE with Run-Time Error 246
OutlineShowAllTasks
OutlineShowAllTasks
EditCopy
Set ws = Worksheets(Range("C3").Value)
Set rng = ws.Range("A:A")
ActiveSheet.Paste Destination:=rng
'column2-Task Name
SelectTaskColumn Column:="Name"
EditCopy
Set rng = ws.Range("B:B")
ActiveSheet.Paste Destination:=rng
'column3-Finish Date
SelectTaskColumn Column:="Finish"
EditCopy
Set rng = ws.Range("C:C")
ActiveSheet.Paste Destination:=rng
'***Close Project file*******************************
appProj2.FileClose pjDoNotSave
appProj2.Quit
Set appProj2 = Nothing
'third loop removed to reduce space on forum
AppActivate "Excel"
Application.DisplayAlerts = True
'appProj.DisplayAlerts = True
End Sub
Last edited: