'Find task in MS Project by custom field value
i'm currently using below function to find a MS project task based on custom field value, it works perfectly when a parent task object is provided, it only loops through children tasks. The problem is that now in plan target task could be placed any where in plan and it takes some time looping through all the ~3k tasks in plan trying to find the correct task based on custom field value. Is there a way i could do this faster?
**'sub to test Function**
Public Sub TestFunction()
Dim TaskObject as Object
Dim MSapp as Object '<- MS project application
Dim ErrMsg as String
set TaskObject = funGetTaskByFieldRef(objMSPapp:=MSapp,
fieldValue:="Key1234",
fieldName:= "customForeingKeyField",
ErrMsg:= ErrMsg)
if TaskObject is nothing then
MsgBox ErrMsg
else
Debug.Print TaskObject.UniqueID & " - " & TaskObject.Name
end if
End Sub
**'Function - - -**
Public Function funGetTaskByFieldRef(ByRef objMSPapp As Object, ByVal fieldValue As String, _
ByVal fieldName As String, _
Optional ByRef objParentTask As Object, _
Optional ByRef ErrMsg As String = vbNullString) As Object
'<VARIABLES>
Dim obMSPprj As Object
Dim tsk As Object
Dim tmpValue As String
'</VARIABLES>
'<FUN> ---
'set temporal var Microsoft Project
Set obMSPprj = objMSPapp.ActiveProject
'using project
With obMSPprj
'check if parent task has been provided
If Not objParentTask Is Nothing Then
'loop through each child
For Each tsk In objParentTask.OutlineChildren
tmpValue = funSetGetMSPval(objMSPapp, tsk, 0, "Get", fieldName)
If tmpValue = fieldValue Then
'retunr UID
Set funGetTaskByFieldRef = tsk
'exit function
Exit Function
End If
Next tsk
Else
'loop through each task
For Each tsk In .Tasks
tmpValue = funSetGetMSPval(objMSPapp, tsk, 0, "Get", fieldName)
If tmpValue = fieldValue Then
'retunr UID
Set funGetTaskByFieldRef = tsk
'exit function
Exit Function
End If
Next tsk
End If
End With
'if there is no exact match for task name return -1
Set funGetTaskByFieldRef = Nothing
ErrMsg = "Task not found"
'<FUN> ---
End Function
**'Encapsulated sub-function **
Public Function funSetGetMSPval(ByRef objMSPapp As Object, ByRef objEntObj As Object, _
ByVal intPjFieldType As Integer, ByVal strAction As String, _
Optional ByVal strFldName As String, _
Optional ByVal strVal As String) As Variant
'pjProject = 2
'pjResource =1
'pjTask = 0
With objMSPapp
Select Case strAction
Case "Set"
On Error Resume Next
objEntObj.SetField .FieldNameToFieldConstant(strFldName, intPjFieldType), strVal
If Not Err.Number <> 0 Then
'catch error
End If
On Error GoTo 0
funSetGetMSPval = True
Case "Get"
funSetGetMSPval = objEntObj.getfield(.FieldNameToFieldConstant(strFldName, intPjFieldType))
End Select
End With
End Function
Hope there is someone that has a better way to do this.
thank you.
regards.
Solution 1:[1]
Is there a way i could do this faster?
Yes, use the Find method.
Public Sub FindTask()
Dim TaskObject As Object
Dim MSapp As Object
Set MSapp = Application
Dim found As Boolean
found = MSapp.Find(Field:="customForeingKeyField", Test:="equals", Value:="Key1234")
If found Then
Set TaskObject = MSapp.ActiveCell.Task
Debug.Print TaskObject.UniqueID & " - " & TaskObject.Name
Else
MsgBox "Task not found"
End If
End Sub
Sources
This article follows the attribution requirements of Stack Overflow and is licensed under CC BY-SA 3.0.
Source: Stack Overflow
| Solution | Source |
|---|---|
| Solution 1 | Rachel Hettinger |