Earlier in part 1 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

  • ThisProject
  • 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

Advertisements