通过MS项目中的任务名称自动添加资源

Question

我想为MS项目中的某些任务（子任务）自动添加资源名称例如如果任务是CMM，我想自动将CMM添加到资源名称这是我的代码

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

Answer 1

此代码根据任务名称为任务分配资源。假设任务名称通常比单个单词更具描述性，则代码使用contains搜索（例如Like）。如果资源尚不存在，则将其添加。

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