Trying to open an excel sheet from within MS Project and copy data across...

miless2111s

Active Member
Joined
Feb 10, 2016
Messages
279
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
I am attempting to produce some VBA in MS project to:

  1. Open a new instance of Excel
  2. Set up some columns
  3. Apply a filter in MSP and copy the contents
  4. Paste into the opened Excel file
  5. Save the Excel file
  6. Close the excel file
This is all being done for each resource in the project plan (there are three at the moment).

I have been using some code I produced a very long time ago which didn't have to iterate and open and close many Excel files and I wonder if this is what is giving me trouble.

At the moment I have three key issues;

  1. The paste command doesn't work. I have tried many types of paste and they either result in a picture including the Gantt chart being pasted in or nothing happens.
  2. The middle of three resources seems to be missed out - I suspect some error is happening which results in the loop being abandoned.
  3. I get multiple errors:
    1. Error: Invalid Procedure call or Argument
    2. Error: Object variable or With clock variable not set.
If anyone can help me out I would be grateful :)

My code:
VBA Code:
Sub emailFilteredResources()
 Dim MyXL As Object
 Dim Version As String
 Dim MSP_name As String
 Dim finish As Date
 Dim name As String
 Dim email As String
 
    
    On Error Resume Next                ' keep going on an error
    
'message box asking for date for next friday
    finish = InputBox("Please enter the date for next Friday", "Date entry", Int(Now() + 8)) 'assumes that we will be running this on Thursday

'display all tasks
    OutlineShowAllTasks
    
    SelectBeginning                     ' restart from the beginning
    
For Each Resource In ActiveProject.Resources
    If Resource.Work > 0 Then
    
    'setup and apply filter for each resource
    FilterEdit name:="filter4people", TaskFilter:=True, Create:=True, OverwriteExisting:=True, FieldName:="Start", Test:="is less than or equal to", Value:=finish, ShowInMenu:=True, ShowSummaryTasks:=True
    FilterEdit name:="filter4people", TaskFilter:=True, FieldName:="", NewFieldName:="% Complete", Test:="is less than", Value:="100%", Operation:="And", ShowSummaryTasks:=True
    FilterEdit name:="filter4people", TaskFilter:=True, FieldName:="", NewFieldName:="Resource names", Test:="contains", Value:=Resource.name, Operation:="And", ShowSummaryTasks:=True
        
    FilterApply "filter4people" ' apply the filter
        If (Err.Number) Then            ' saw an error applying filter
            MsgBox "ERROR: " & Err.Description
            Err.Clear                   ' clear out the error
            GoTo NextResource           ' jump to the next resource
        End If
    End If
'gather date from resource (name, email) as variables to be called later
    name = Resource.name
    email = Resource.EMailAddress

'Copy data from the view
    SelectAll
    EditCopy
    rows = CStr(ActiveSelection.Tasks.Count)
    Debug.Print name
    Debug.Print email
    
'setup excel file

 
    'Set the file version using time stamp.  Would be nice to have a-z rather than h:m:s but that can follow
    Version = Format(Now, "yyyy-mmm-dd hh-mm-ss")
 
    'find the current project's path and set the file name for the excel file to be produced
    myFilePath = ActiveProject.Path
    myfilename = myFilePath & "\" & name & " " & Version & ".xlsx"
    
    Set MyXL = CreateObject("Excel.Application")
    MyXL.Workbooks.Add
 
    'MyXL.workbooks.Add.Name = "Exceptions.xlsx"
    MyXL.Visible = True

    MyXL.ActiveWorkbook.Worksheets.Add.name = "Weekly look ahead"
    MyXL.ActiveWorkbook.Worksheets("Weekly look ahead").Activate

    Set xlrange = MyXL.ActiveSheet.Range("A1")
'set the page titles in Excel
    xlrange.Range("o1") = "Start"
    xlrange.Range("o2") = "Finish"
    xlrange.Range("p1") = finish - 7
    xlrange.Range("p2") = finish
    xlrange.Range("r1") = "key"
    xlrange.Range("r2") = "Late"
    xlrange.Range("r3") = "Finishing this week"
    xlrange.Range("r4") = "Starting this week"
    xlrange.Range("r5") = "In play this week"
'Set formats for colour key
    xlrange.Range("R2").Font.ColorIndex = 2
    xlrange.Range("r2").Interior.ColorIndex = 3
    xlrange.Range("r3").Interior.ColorIndex = 45
    xlrange.Range("r4").Interior.ColorIndex = 43
    xlrange.Range("r5").Interior.ColorIndex = 15
         
'paste in values to excel file  THIS IS THE ISSUE!!
    'xlrange.Range("a1").Paste '- nothing
    'ActiveSheet.Paste Destination:=xlrange.Range("A1:g" & rows + 1) '- nothing
    'xlrange.Range("A1:g" & rows + 1).PasteSpecial Paste:=xlpastevalues '- paste picture
    'xlrange.Range("A:G").PasteSpecial xlPasteValues '- paste picture
    'xlrange.Range("A1:g" & rows + 1).Paste '- nothing pastes
    xlrange.Select
    ActiveSheet.Paste '-nothing again :(
    
'put conditional formatting in place in excel
    
'set column widths
    With MyXL.ActiveWorkbook.Worksheets("Weekly look ahead")
        .Columns("A:R").AutoFit
    End With
 
    xlrange.Columns("A:A").ColumnWidth = 100
    xlrange.Columns("A:A").EntireColumn.AutoFit
    With xlrange.Range("a1:G" & row + 1)
        .WrapText = True
        .EntireRow.AutoFit
    End With
    
'save excel file
    MyXL.ActiveWorkbook.SaveAs myfilename
    MyXL.ActiveWorkbook.Close
    MyXL.Quit
    Set MyXL = Nothing
    
'send excel file
    
'shift focus back to MS Project
    AppActivate "Microsoft Project"
    
NextResource:
    Next Resource
    
    FilterApply name:="All Tasks"       ' apply the filter

End Sub
 

Excel Facts

Copy formula down without changing references
If you have =SUM(F2:F49) in F50; type Alt+' in F51 to copy =SUM(F2:F49) to F51, leaving the formula in edit mode. Change SUM to COUNT.
something that I didn't mention in the original post was that the code hadn't had to copy/paste before so that bit is new. The copy is done by the SelectAll and then EditCopy comment. I know this is working as I can manually paste what it is designed to copy. The paste bit is in the section "'paste in values to excel file THIS IS THE ISSUE!!" which shows the ways that it fails to copy (either nothing happens, not even an error or I get a picture of the table and Gantt; which doesn't turn up when I manually paste it!
 
Upvote 0
Update:
1) I solved the problems with the copy / paste by not using copy and paste :) Rather I read the data which I intended to copy into an array which was then "printed out" into Excel.
2) The issue with opening and closing excel was resolved by starting with a small section of code which opened the file, then saving it as a different name, then adding more complexity until I had the final output. I am still not sure what I did wrong in the original code but it all works now.
A remaining issue is how to declare all the variables when MS Project doesn't have a dim Rng as Range option so some of the excel specific variables "can't" be declared. This generates an error 91 condition which caused some pretty funky results with the section of code:
VBA Code:
If (Err.Number) Then            ' saw an error applying filter            
MsgBox "ERROR: " & Err.Description            
Err.Clear                   ' clear out the error            
GoTo NextResource           ' jump to the next resource        
End If
As the first time the macro encounters this code error = 0 however when it comes across something like set "rng = ....("A:C")" the error state goes to error = 91. This means on the next resource loop the (err.number) triggers which 1) sets the error back to 0 and calls the next resource. On this loop the code executes but sets the error back to 91 and so on. This meant that all "odd" resources were outputting but "even" ones didn't!
 
Upvote 0

Forum statistics

Threads
1,223,231
Messages
6,170,884
Members
452,364
Latest member
springate

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