Search code examples
vbams-project

Add resource automatically by task name in MS-project


I want to automatically add resource name just for some task (sub-task) in MS-project for example if task is CMM i want automatically add CMM to resource name And this is my code

Sub Automatically()
Dim NR As MsProject.Resource
Dim Tsk As MsProject.Task
Dim Row As Integer
For each row in Ms.Project.Task
          If Tsk = "CMM" Or "EDM" Or "EL Milling" Or "CAM Wire cut" Or "Laser Welding" Or "Wire cut" Or "CNC Milling" Or "Grinding" Or "Lathe" Or "Manual Milling" Or "Polishing"
               Set NR = NR.Resource.Add.Tsk
          End If
          If Tsk = "Inspection" Or "Report" Then
               Set NR =  "CMM"
          End if
Next row
End Sub

Solution

  • This code assigns resources to tasks based on the names of the tasks. Given that task names are typically more descriptive than a single word, the code uses a contains search (e.g. Like). If the resource does not already exist, it is added.

    Sub AddResourceAssignments()
    
        Dim resName As String
    
        Dim tsk As Task
        For Each tsk In ActiveProject.Tasks
            ' determine the resource to add to the task
            Select Case True
                Case (tsk.Name Like "*Gate*"): resName = "Gate"
                Case (tsk.Name Like "*CMM*"): resName = "CMM"
                Case (tsk.Name Like "*EDM*"): resName = "EDM"
                Case (tsk.Name Like "*EL Milling*"): resName = "EL Milling"
                Case (tsk.Name Like "*CAM Wire cut*"): resName = "CAM Wire cut"
                Case (tsk.Name Like "*Laser Welding*"): resName = "Laser Welding"
                Case (tsk.Name Like "*Wire cut*"): resName = "Wire cut"
                Case (tsk.Name Like "*CNC Milling*"): resName = "CNC Milling"
                Case (tsk.Name Like "*Grinding*"): resName = "Grinding"
                Case (tsk.Name Like "*Lathe*"): resName = "Lathe"
                Case (tsk.Name Like "*Manual Milling*"): resName = "Manual Milling"
                Case (tsk.Name Like "*Polishing*"): resName = "Polishing"
                Case (tsk.Name Like "*Inspection*"): resName = "CMM"
                Case (tsk.Name Like "*Report*"): resName = "CMM"
                Case Else: resName = vbNullString
            End Select
    
            If Len(resName) > 0 Then
                ' create the resource assignment
                On Error Resume Next
                Dim res As Resource
                Set res = ActiveProject.Resources(resName)
                If Err.Number <> 0 Then
                    ' presume error due to missing resource
                    Set res = ActiveProject.Resources.Add(Name:=resName)
                End If
                tsk.Assignments.Add ResourceID:=res.ID
            End If
    
        Next tsk
    
    End Sub