Earlier in part 1 of disable local resources I described the aim of disabling the use of local resources. Today I will show you how to implement this.
There are two modules we’re going to develop
- This Project
- Resource check Class module
The resource check class module is giving us the event handlers that can be used by the solution. First Create a new class module and call it ResourceCheck.
Add to the class module the following line:
Public WithEvents App As Application
Each task in my project can have a the following situations.
- No resources assigned to a task
- All resources are enterprise resources
- All resources are local
- There are incomplete resources (enterprise resources without an account assigned to them)
Then for the different situations we’re creating an enumeration and a variable storing the Checkresults:
Private Enum ResourceCheckResults
Unknown
AllEnterprise
LocalResource
IncompleteEnterpriseResource
End Enum
Dim ResCheckResult As ResourceCheckResults
Then to create a function which checks a resource collection and returns site what type of resources are found.
Public Function GetCheckResultForResources(Resources) As Integer
Dim CheckResults As ResourceCheckResults: CheckResults = Unknown
For Each Resource In Resources
If Resource.Enterprise Then
If CheckResults = Unknown Or CheckResults = AllEnterpriseResources Then
If Resource.EMailAddress = “” Or Resource.WindowsUserAccount = “” Then
CheckResults = IncompleteEnterpriseResource
Else
CheckResults = AllEnterpriseResources
End If
End If
Else
CheckResults = LocalResource
End If
Next Resource
GetCheckResultForResources = CheckResults
End Function
Ok so the base work has now been done. Now we need to make sure that the results are checked when a user updates the resources in a project. There are quite a few event handlers relevant here.
The event handlers I’ve considered here are:
- App_ProjectBeforeAssignmentChange – Occurs before the user changes the value of an assignment field.
- App_ProjectBeforeAssignmentDelete – Occurs before an assignment is removed or replaced
- App_ProjectBeforeResourceChange – Occurs before the user changes the value of a resource field
- App_ProjectBeforeTaskChange – Occurs before the user changes the value of a task field
- App_ProjectBeforeSave2 – Occurs before a project is saved.
ProjectBeforeAssignmentChange
When a resource is assigned to a task the following event handler will check if an Enterprise or a local user is added. When a local user is added the assignement is cancelled.
Private Sub App_ProjectBeforeAssignmentChange(ByVal asg As Assignment, ByVal Field As PjAssignmentField, ByVal NewVal As Variant, Cancel As Boolean)
On Error GoTo ErrHandler:
If (asg.Resource.Enterprise) Then
If (ResCheckResult = Unknown Or ResCheckResult = AllEnterprise) Then
ResCheckResult = AllEnterprise
End If
Else
ResCheckResult = LocalResource
MsgBox (asg.Resource.Name & ” is NOT an enterprise user”)
Cancel = True
End If
Exit Sub ErrHandler:
‘ No need to do anything just ignore the error
Exit Sub
End Sub
ProjectBeforeAssignmentDelete
As part of the solution I changed the colour of the resource. Depending on if we’re talking about a Local or an Enterprise resource. Therefore when a resource is deleted the colour of the task’s resource needs to be reviewed
Private Sub App_ProjectBeforeAssignmentDelete(ByVal asg As Assignment, Cancel As Boolean)
On Error GoTo ErrHandler:
ResCheckResult = GetCheckResultForResources(asg.Task.Resources)
Select Case CheckResults
Case LocalResource
asg.Application.ActiveCell.FontColor = pjRed
Case Unknown
asg.Application.ActiveCell.FontColor = pjBlack
Case AllEnterprise
asg.Application.ActiveCell.FontColor = pjBlack
Case IncompleteEnterpriseResource
asg.Application.ActiveCell.FontColor = pjBlue
End Select
Exit Sub
ErrHandler:
‘ No need to do anything just ignore the error
Exit Sub
End Sub
ProjectBeforeResourceChange
Private Sub App_ProjectBeforeResourceChange(ByVal res As Resource, ByVal Field As PjField, ByVal NewVal As Variant, Cancel As Boolean)
If (res.Enterprise) Then
Debug.Print (res.Name & ” is an enterprise user”)
Else
MsgBox (NewVal & ” is NOT an enterprise user”)
Cancel = True
End If
End Sub
ProjectBeforeTaskChange
Private Sub App_ProjectBeforeTaskChange(ByVal tsk As MSProject.Task, ByVal Field As PjField, ByVal NewVal As Variant, Cancel As Boolean)
On Error GoTo ErrHandler:
CheckResults = GetCheckResultForResources(tsk.Resources)
Select Case CheckResults
Case LocalResource
tsk.Application.ActiveCell.FontColor = pjRed
Case Unknown
tsk.Application.ActiveCell.FontColor = pjBlack
Case AllEnterprise
tsk.Application.ActiveCell.FontColor = pjBlack
Case IncompleteEnterpriseResource
tsk.Application.ActiveCell.FontColor = pjBlue
End Select
Exit Sub
ErrHandler:
‘ Just ignore the errors
Exit Sub
End Sub
ProjectBeforeSave2
Private Sub App_ProjectBeforeSave2(ByVal pj As Project, ByVal SaveAsUi As Boolean, ByVal Info As EventInfo)
Dim MyResource As Resource
Dim ResourceID
Dim LocalResources As String
Dim EnterWithoutEmail As String
Dim EnterWithoutAccount As String
Dim NewColour
If ThisProject.Application.Projects.Count > 0 Then
For Each Task In ThisProject.Application.Projects(1).Tasks
If Not Task Is Nothing Then
For Each MyResource In Task.Resources
If Not MyResource.Enterprise Then
LocalResources = LocalResources + MyResource.Name + “;”
End If
If MyResource.EMailAddress = “” Then
EnterWithoutEmail = EnterWithoutEmail + MyResource.Name + “;”
End If
If MyResource.WindowsUserAccount= “” Then
EnterWithoutAccount = EnterWithoutAccount + MyResource.Name + “;”
End If
Next MyResource
End If
Next Task
End If
If LocalResources + EnterWithoutEmail + EnterWithoutAccount <> “” Then
If LocalResources = “” Then
MsgBox (“Please report the following details to your system administrator: ” & vbNewLine & “Enterprise resources without email: ” & EnterWithoutEmail & vbNewLine & vbNewLine & “Enterprise resources without account: ” & EnterWithoutAccount)
Else
If EnterWithoutEmail + EnterWithoutAccount = “” Then
MsgBox (“Please remove the following local resources: ” & vbNewLine & LocalResources)
Else
MsgBox (“Please remove the following local resources: ” & vbNewLine & LocalResources & vbNewLine & vbNewLine & “Please report the following details to your system administrator: ” & vbNewLine & “Enterprise resources without email: ” & EnterWithoutEmail & vbNewLine & vbNewLine & “Enterprise resources without account: ” & EnterWithoutAccount)
Info.Cancel = True
End If
End If
End If
End Sub
Then now the final steps. How do we get the Event handlers to run.
Open the This project and specify the following variables and Enumeration:
Dim MyApp As New ResourceChecks
Private Enum TaskResourceCheckResults
Unknown
AllEnterpriseResources
LocalResource
IncompleteEnterpriseResource
End Enum
Then there are a couple of Subs to make our live easier:
UpdateResourceColours
Private Sub UpdateResourceColours(Tasks As Object)
Dim NewColour
Dim OldColour
Dim TaskLine
On Error GoTo ErrHandler:
TaskLine = 0
For Each Task In Tasks
TaskLine = TaskLine + 1
If Task Is Nothing Then
‘Blank lines to be ignored
Else
SelectRow Task.UniqueID, RowRelative:=False
SelectTaskField Row:=TaskLine, RowRelative:=False, Column:=”Resource Names”
OldColour = MyApp.App.ActiveCell.FontColor
If Task.Resources.Count = 0 Then
NewColour = pjBlack
Else
CheckResults = MyApp.GetCheckResultForResources(Task.Resources)
Select Case CheckResults
Case LocalResource
NewColour = pjRed
Case Unknown
NewColour = pjBlack
Case AllEnterprise
NewColour = pjBlack
Case IncompleteEnterpriseResource
NewColour = pjBlue
End Select
End If
End If
If NewColour <> OldColour Then
Font Color:=NewColour
End If
Next Task
SelectRow Tasks(1).UniqueID, RowRelative:=False
Exit Sub
ErrHandler:
If MyApp.App Is Nothing Then
MsgBox (“Please reload your project”)
Exit Sub
End If
Exit Sub
End Sub
Report_LocalResources
Private Sub Report_LocalResources(ByVal pj As Project)
On Error GoTo ErrHandler:
For Each Resource In pj.Resources
If Not Resource.Enterprise Then
If Resource.Name = Empty Then
‘ An Empty resource has been added to the project resources. This one needs to be removed too If LocalResourceList = Empty Then
LocalResourceList = Resource.ID
NumLocalResources = 1
Else
LocalResourceList = LocalResourceList & “,” & Resource.ID
NumLocalResources = NumLocalResources + 1
End If
Else
If LocalResourceList = Empty Then
LocalResourceList = Resource.Name
NumLocalResources = 1
Else
LocalResourceList = LocalResourceList & “,” & Resource.Name
NumLocalResources = NumLocalResources + 1
End If
End If
End If
Next Resource
If LocalResourceList <> Empty Then
MsgBox (NumLocalResources & ” local resources have been found Please remove these resources from the Resources, Add Resources, Build team from Enterprise option in the Project”)
End If
Exit Sub
ErrHandler: ‘ Ignore Errors
Exit Sub
End Sub
Ok so now all the hard work has been done all we need to do is create an object when a project is opened and call ourfunctions and subs to update the resource names column’s colour.
Private Sub Project_Open(ByVal pj As Project)
On Error GoTo ErrHandler:
Dim CheckResult As TaskResourceCheckResults
CheckResults = Unknown
Set MyApp.App = Application
UpdateResourceColours pj.Tasks
Exit Sub
ErrHandler:
‘ Ignore Errors
Exit Sub
End Sub
Private Sub Project_BeforeSave(ByVal pj As Project)
On Error GoTo ErrHandler:
Dim LocalResourceList As String: LocalResourceList = Empty
Dim NumLocalResources As Integer Debug.Print (“BeforeSave”)
UpdateResourceColours pj.Tasks
Report_LocalResources pj
Exit Sub
ErrHandler:
‘ Ignore Errors
Exit Sub
End Sub