-
Aug 2nd, 2016, 05:11 AM
#1
Thread Starter
Registered User
Using VBA to extract from multiple Project files data to Excel
Hi All
I want to loop through multiple project files by row and extract certain rows to the same tab within excel.
I have found the code below and would like to run it over each file after selecting multiple .mpps from explorer and populate a tab within an existing workbook.
Any help would be appreciated.
Regards
Sean
Option Explicit
Dim xlRow As Excel.Range
Dim xlCol As Excel.Range
Sub TaskHierarchy()
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Dim t As Task
Dim Asgn As Assignment
Dim ColumnCount As Integer
Dim Columns As Integer
Dim Tcount As Integer
Dim Proj As MSProject.Application
' Dim start As Date
' Dim deadline As Date
' Dim finish As Date
' Dim Final_Row As Long
' Dim i As Long 'counter
Set Proj = CreateObject("MSProject.Application")
Proj.Visible = False
Proj.FileOpen Name:="S:\Information\Design Systems Engineering\Open Access Data\HPC\Admin\HPC Gantt Blank.mpp", ReadOnly:=True
Set xlApp = ThisWorkbook.Application
'Set xlApp = New Excel.Application
'xlApp.Visible = True
'AppActivate "Microsoft Excel"
Set xlBook = xlApp.ThisWorkbook
Set xlSheet = xlBook.Worksheets.Add
'********************************** end of declaring workbooks/sheets/locations etc *********************************************
'count columns needed
ColumnCount = 0
For Each t In ActiveProject.Tasks
If Not t Is Nothing Then
If t.OutlineLevel > ColumnCount Then
ColumnCount = t.OutlineLevel
End If
End If
Next t
'Set Range to write to first cell
Set xlRow = xlApp.Range("A1")
xlRow = "Filename: " & "Amended Details"
dwn 1
'label Columns
For Columns = 1 To (ColumnCount + 1)
Set xlCol = xlRow.Offset(0, Columns - 1)
xlCol = Columns - 1
Next Columns
rgt 1
xlCol = "Analysis"
rgt 1
xlCol = "Application"
rgt 1
xlCol = "Analysis Start Date"
rgt 1
xlCol = "Analysis Drop Dead Date"
rgt 1
xlCol = "Analysis End Date"
rgt 1
xlCol = "Cluster Name"
rgt 1
xlCol = "Number of Cores"
rgt 1
xlCol = "Required Disk Space"
rgt 1
xlCol = "Required Priority"
Tcount = 0
'**********************************************Naming Columns/layout etc for new sheet********************************************
'***************Loop to format cells above ***************
For Each t In ActiveProject.Tasks
If Not t Is Nothing Then
dwn 1
Set xlCol = xlRow.Offset(0, Columns - 1)
xlCol = Columns - 1
xlCol = t.Text3
rgt 1
xlCol = t.Text4 ' list all columns to offset on copy over!!!!
rgt 1
xlCol = t.start
rgt 1
xlCol = t.deadline
rgt 1
xlCol = t.finish
rgt 1
xlCol = t.Text1
rgt 1
xlCol = t.Number3
rgt 1
xlCol = t.Number2
rgt 1
xlCol = t.OutlineCode1
Tcount = Tcount + 1
End If
Next t
AppActivate "Microsoft Excel"
MsgBox ("Macro Complete with " & Tcount & " Tasks Written")
End Sub
Sub dwn(i As Integer)
Set xlRow = xlRow.Offset(i, 0)
End Sub
Sub rgt(i As Integer)
Set xlCol = xlCol.Offset(0, i)
End Sub
-
Aug 2nd, 2016, 04:36 PM
#2
Re: Using VBA to extract from multiple Project files data to Excel
this should be changed like
Code:
'label Columns
For Columns = 1 To (ColumnCount + 1)
Set xlCol = xlRow.Offset(0, Columns - 1)
'xlCol = Columns - 1
'rgt 1
xlCol = "Analysis"
'rgt 1
xlCol = "Application"
'rgt 1
xlCol = "Analysis Start Date"
'rgt 1
xlCol = "Analysis Drop Dead Date"
'rgt 1
xlCol = "Analysis End Date"
'rgt 1
xlCol = "Cluster Name"
'rgt 1
xlCol = "Number of Cores"
'rgt 1
xlCol = "Required Disk Space"
'rgt 1
xlCol = "Required Priority"
Next Columns
also columns is an excel keyword and should be avoided as a variable
this should also be changed like
Code:
For Each t In proj.ActiveProject.Tasks 'activeproject is not valid with excel application, but better to set the poject file to a project object when opening the file
If Not t Is Nothing Then
' dwn 1
Set xlCol = xlRow.Offset(tcount + 2, Columns - 1) ' use next row also columns now contains columncount +2 from the previous loop which has already finished, so you need to also loop columns within the looping of tasks
'xlCol = Columns - 1 ' puts column number in cell
the rgt and dwn procedures should be removed just change the offsets within the existing code like
Code:
For Each t In ActiveProject.Tasks
If Not t Is Nothing Then
dwn 1
Set xlCol = xlRow.Offset(tcount + 2, 0)
'xlCol = Columns - 1
xlCol.offset(,1) = t.Text3
xlCol.offset(,2) = t.Text4 ' list all columns to offset on copy over!!!!
xlCol.offset(,3) = t.start
xlCol.offset(,4)= t.deadline
xlCol.offset(.5) = t.finish
xlCol.offset(,6) = t.Text1
xlCol.offset(,7) = t.Number3
xlCol.offset(,8) = t.Number2
xlCol.offset(,9) = t.OutlineCode1
Tcount = Tcount + 1
End If
Next t
i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case.
Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next
dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part
come back and mark your original post as resolved if your problem is fixed
pete
-
Aug 2nd, 2016, 07:58 PM
#3
Thread Starter
Registered User
Re: Using VBA to extract from multiple Project files data to Excel
Originally Posted by westconn1
this should be changed like
Code:
'label Columns
For Columns = 1 To (ColumnCount + 1)
Set xlCol = xlRow.Offset(0, Columns - 1)
'xlCol = Columns - 1
'rgt 1
xlCol = "Analysis"
'rgt 1
xlCol = "Application"
'rgt 1
xlCol = "Analysis Start Date"
'rgt 1
xlCol = "Analysis Drop Dead Date"
'rgt 1
xlCol = "Analysis End Date"
'rgt 1
xlCol = "Cluster Name"
'rgt 1
xlCol = "Number of Cores"
'rgt 1
xlCol = "Required Disk Space"
'rgt 1
xlCol = "Required Priority"
Next Columns
also columns is an excel keyword and should be avoided as a variable
this should also be changed like
Code:
For Each t In proj.ActiveProject.Tasks 'activeproject is not valid with excel application, but better to set the poject file to a project object when opening the file
If Not t Is Nothing Then
' dwn 1
Set xlCol = xlRow.Offset(tcount + 2, Columns - 1) ' use next row also columns now contains columncount +2 from the previous loop which has already finished, so you need to also loop columns within the looping of tasks
'xlCol = Columns - 1 ' puts column number in cell
the rgt and dwn procedures should be removed just change the offsets within the existing code like
Code:
For Each t In ActiveProject.Tasks
If Not t Is Nothing Then
dwn 1
Set xlCol = xlRow.Offset(tcount + 2, 0)
'xlCol = Columns - 1
xlCol.offset(,1) = t.Text3
xlCol.offset(,2) = t.Text4 ' list all columns to offset on copy over!!!!
xlCol.offset(,3) = t.start
xlCol.offset(,4)= t.deadline
xlCol.offset(.5) = t.finish
xlCol.offset(,6) = t.Text1
xlCol.offset(,7) = t.Number3
xlCol.offset(,8) = t.Number2
xlCol.offset(,9) = t.OutlineCode1
Tcount = Tcount + 1
End If
Next t
Thanks Pete
I need to be able to select multiple project files loop, through one, extract to excel and then open and loop through the next etc.
Any ideas?
Regards
Sean
-
Aug 3rd, 2016, 07:49 AM
#4
Re: Using VBA to extract from multiple Project files data to Excel
I need to be able to select multiple project files loop
what is the criteria for selection of files?
i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case.
Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next
dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part
come back and mark your original post as resolved if your problem is fixed
pete
-
Aug 3rd, 2016, 04:08 PM
#5
Thread Starter
Registered User
Re: Using VBA to extract from multiple Project files data to Excel
Hi Pete
Selecting multiple files from a explorer dialog box and looping through them one by one.
Regards
Sean
-
Aug 4th, 2016, 07:08 AM
#6
Re: Using VBA to extract from multiple Project files data to Excel
i just copied this from a recent thread in this forum
Code:
Application.FileDialog(msoFileDialogOpen).AllowMultiSelect = False
'make the file dialog visible to the user
intChoice = Application.FileDialog(msoFileDialogOpen).Show
'determine what choice the user made
If intChoice <> 0 Then
'get the file path selected by the user
strPath = Application.FileDialog( _
msoFileDialogOpen).SelectedItems(1)
End If
change multiselect to true
change the last lines to
Code:
if intchoice = 0 then exit sub ' no files chosen
for i = 1 to Application.FileDialog(msoFileDialogOpen).SelectedItems.count
set myproj = Proj.FileOpen(Application.FileDialog(msoFileDialogOpen).SelectedItems(i), ReadOnly:=True)
For Each t In myproj.Tasks
' all your code in here
next ' task
next ' filename
as i said first, this is just copied from some other thread, completely untested by me
won't run on my version of excel any way!!
i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case.
Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next
dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part
come back and mark your original post as resolved if your problem is fixed
pete
-
Jul 3rd, 2018, 09:16 AM
#7
Junior Member
Re: Using VBA to extract from multiple Project files data to Excel
Originally Posted by westconn1
i just copied this from a recent thread in this forum
Code:
Application.FileDialog(msoFileDialogOpen).AllowMultiSelect = False
'make the file dialog visible to the user
intChoice = Application.FileDialog(msoFileDialogOpen).Show
'determine what choice the user made
If intChoice <> 0 Then
'get the file path selected by the user
strPath = Application.FileDialog( _
msoFileDialogOpen).SelectedItems(1)
End If
change multiselect to true
change the last lines to
Code:
if intchoice = 0 then exit sub ' no files chosen
for i = 1 to Application.FileDialog(msoFileDialogOpen).SelectedItems.count
set myproj = Proj.FileOpen(Application.FileDialog(msoFileDialogOpen).SelectedItems(i), ReadOnly:=True)
For Each t In myproj.Tasks
' all your code in here
next ' task
next ' filename
as i said first, this is just copied from some other thread, completely untested by me
won't run on my version of excel any way!!
Good Morning Everyone,
Looking at this code I was wondering what the code now looks like with all of the changes. I'm trying to utilize the same VBA Coding in order to consolidate multiple project data and create burndowns in excel. Also, I'm fairly new to VBA in general and was wondering if you had any recommendations on resources I could use to start learning!
-
Jul 3rd, 2018, 04:02 PM
#8
Re: Using VBA to extract from multiple Project files data to Excel
i have never tested the code posted here and as the OP never posted feed back i just assume it must have done what he wanted or was able to modify to do as required
i have no experience with project, but modified code based on original code posted by the OP to assign values to an excel workbook
the code above is written to work in excel, automating project, but could equally be done in project and automating excel
while i am sure there are many good books on vba, my resources are vb forums and google, if you are using an older version of office make sure to have the vba help installed, in the new versions, unfortunately, all the help is online
i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case.
Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next
dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part
come back and mark your original post as resolved if your problem is fixed
pete
-
Jul 5th, 2018, 10:55 AM
#9
Junior Member
Re: Using VBA to extract from multiple Project files data to Excel
West,
I appreciate the feed back. I think it's a fair assumption to say the code you posted was a great baseline. I'll keep looking at it and learning from some analysis of how each line functions. Appreciate it!
-
Jul 5th, 2018, 04:12 PM
#10
Re: Using VBA to extract from multiple Project files data to Excel
if you have specific problems, just post in a new thread, with the code as you have it and whatever problem you have and i will try to help
i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case.
Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next
dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part
come back and mark your original post as resolved if your problem is fixed
pete
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|