I am attempting to produce some VBA in MS project to:
Open a new instance of Excel
Set up some columns
Apply a filter in MSP and copy the contents
Paste into the opened Excel file
Save the Excel file
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;
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.
The middle of three resources seems to be missed out - I suspect some error is happening which results in the loop being abandoned.
I get multiple errors:
Error: Invalid Procedure call or Argument
Error: Object variable or With clock variable not set.
I know that the table is being copied into the clipboard as I can pause the code and manually paste it into Excel with <ctrl><v>. I have tried multiple methods of paste as you can see in the section titled "this is where the problem is" and the result of each has been recorded alongside; it is either nothing visible happens or I get a picture being pasted in!
If anyone can help me out I would be grateful
My code:
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