- Deutsch
- English
- Code
Häufig sollen Werte für Benutzerdefinierte Enterprise-Felder (ECF) per Makro (VBA) gelesen oder gesetzt werden. Dazu ist jeweils im ersten Schritt die ID des ECF zu identifizieren, dafür steht die Funktion FieldNameToFieldConstant zur Verfügung. Als Parameter benötigt diese Funktion den Feldnamen und die Entität des Felds. Mit der erhaltenen Konstanten können dann die Werte mit der Funktion GetField gelesen oder mit der Funktion SetField gesetzt werden. Im Codebereich finden Sie Beispiele für alle Entitäten. Bitte beachten Sie Folgendes:
- Für den Zugriff auf Felder auf der Zuordnungsebene sind die Funktionen GetField und SetField nicht implementiert. Hier erfolgt der Zugriff direkt über den Feldnamen. Das ist nur möglich, wenn die Feldnamen keine Leerzeichen enthalten. Bitte berücksichtigen Sie das schon bei der Anlage von Feldern für die Entitäten Vorgang und Ressource.
- Bitte aktivieren Sie bei der Felddefinition "Abwärts zuordnen, wenn nicht manuell angegeben". Für Project Online ist das aktuell nicht erforderlich, doch ich vermute hier eine Änderung in der nahem Zukunft.
- Werte für Attributfelder müssen mit den in Project angezeigten Werten erfolgen. In deutschsprachigem Projekt ist also "Ja" und "Nein" zu setzen. Da der zu setzende Wert oft als Boolean vorliegt oder ein vorhandener Wert als Boolean benötigt wird, enthält der Code auch zwei Funktionen, die Bool ind Text übersetzen bzw. umgekehrt.
In Makros implementieren / Implement Macros wird beschrieben, wie ein Makro in Project übernommen werden kann. Mehr Beispielmakros sind unter VBA zu finden.
Often values for Enterprise Custom Fields (ECF) are to be read or set by macro (VBA). For this, the ID of the ECF is to be identified in the first step, using function FieldNameToFieldConstant. As a parameter, this function requires the field name and the entity of the field. The retrieved constants can be used to read the values with the GetField function or set them using the SetField function. The code section below contains samples for all entities. Please note the following:
- To access fields on assignment level, the GetField and SetField functions are not implemented. In this case, access to fields has to be done directly using field name. This is only possible if the field names do not contain any spaces. Please take this into account when creating fields for the entities Task and Resource.
- Please activate the field definition "Roll down down, unless manually specified". For Project Online, this is currently not required, but I suspect a change in the near future.
- Values for fields of type Flag must be set using the values displayed in Project. In English Project you need to set "Yes" and "No". Since the value to be set is often available as Boolean, or an existing value is needed as a Boolean, the code also includes two functions that translate Bool to text or vice versa.
Implementing Macros / Implement Macros describes how to apply a macro to Project. More sample code is available at VBA.
Sub ReadWriteECF()
'***********************************************************************************
'Code is provided "AS IS" without warranty of any kind, either expressed or implied,
'including but not limited to the implied warranties of merchantability and/or
'fitness for a particular purpose.
'***********************************************************************************
Dim v_ProjectField_ID As Double
Dim v_ProjectFieldFlag_ID As Double
Dim v_TaskField_ID As Double
Dim v_TaskFieldFlag_ID As Double
Dim v_ResourceField_ID As Double
Dim v_ResourceFieldFlag_ID As Double
Dim v_str As String
Dim v_bool As Boolean
Dim P As Project
Dim T As Task
Dim R As Resource
Dim A As Assignment
'This code provides a simple sample to read/write Enterprise Custom fields for all entities
'Read **********************************************************************************
'Project **********************************************************************************
Set P = ActiveProject
v_ProjectField_ID = Application.FieldNameToFieldConstant("MyProjectField", pjProject)
'Flag fields have to be handled in a different way, therefore another variable
v_ProjectFieldFlag_ID = Application.FieldNameToFieldConstant("MyProjectFieldFlag", pjProject)
'Get value for any type - values of flag fields will be provided as text in your language
v_str = P.ProjectSummaryTask.GetField(v_ProjectField_ID)
'Flag field - get result as text
v_str = P.ProjectSummaryTask.GetField(v_ProjectFieldFlag_ID)
'Flag field - get result as boolean using function TextToBool
v_bool = TextToBool(P.ProjectSummaryTask.GetField(v_ProjectFieldFlag_ID))
'Resource **********************************************************************************
'For sample purposes, set R to first resource if exists
If P.Resources.Count > 0 Then
Set R = P.Resources(1)
v_ResourceField_ID = Application.FieldNameToFieldConstant("MyResourceField", pjResource)
'Flag fields have to be handled in a different way, therefore another variable
v_ResourceFieldFlag_ID = Application.FieldNameToFieldConstant("MyResourceFieldFlag", pjResource)
'Get value for any type - values of flag fields will be provided as text in your language
v_str = R.GetField(v_ResourceField_ID)
'Flag field - get result as text
v_str = R.GetField(v_ResourceFieldFlag_ID)
'Flag field - get result as boolean using function TextToBool
v_bool = TextToBool(R.GetField(v_ResourceFieldFlag_ID))
End If
'Task **********************************************************************************
'For sample purposes, set R to first Task if exists
If P.Tasks.Count > 0 Then
Set T = P.Tasks(1)
v_TaskField_ID = Application.FieldNameToFieldConstant("MyTaskField", pjTask)
'Flag fields have to be handled in a different way, therefore another variable
v_TaskFieldFlag_ID = Application.FieldNameToFieldConstant("MyTaskFieldFlag", pjTask)
'Get value for any type - values of flag fields will be provided as text in your language
v_str = T.GetField(v_TaskField_ID)
'Flag field - get result as text
v_str = T.GetField(v_TaskFieldFlag_ID)
'Flag field - get result as boolean using function TextToBool
v_bool = TextToBool(T.GetField(v_TaskFieldFlag_ID))
End If
'Assignment, get Resource field value ***********************************************
'For assignments, we cannot use "GetField". Field values on assignment level can only
'be accessed directly. This is only possible if field name does not contain spaces!!!!
'For sample purposes, set A to first Assignment of first Resource if exists
If P.Resources.Count > 0 Then
Set R = P.Resources(1)
If R.Assignments.Count > 0 Then
Set A = R.Assignments(1)
'Get value for any type - values of flag fields will be provided as text in your language
v_str = A.MyResourceField
'Flag field - get result as text
v_str = A.MyResourceFieldFlag
'Flag field - get result as boolean using function TextToBool
v_bool = TextToBool(A.MyResourceFieldFlag)
End If
End If
'Assignment, get Task field value ***********************************************
'For assignments, we cannot use "GetField". Field values on assignment level can only
'be accessed directly. This is only possible if field name does not contain spaces!!!!
'For sample purposes, set A to first Assignment of first task if exists
If P.Tasks.Count > 0 Then
Set T = P.Tasks(1)
If T.Assignments.Count > 0 Then
Set A = T.Assignments(1)
'Get value for any type - values of flag fields will be provided as text in your language
v_str = A.MyTaskField
'Flag field - get result as text
v_str = A.MyTaskFieldFlag
'Flag field - get result as boolean using function TextToBool
v_bool = TextToBool(A.MyTaskFieldFlag)
End If
End If
'Write **********************************************************************************
'Project **********************************************************************************
Set P = ActiveProject
v_ProjectField_ID = Application.FieldNameToFieldConstant("MyProjectField", pjProject)
'Flag fields have to be handled in a different way, therefore another variable
v_ProjectFieldFlag_ID = Application.FieldNameToFieldConstant("MyProjectFieldFlag", pjProject)
'Set value for any type - values of flag fields have to be provided as text in your language
P.ProjectSummaryTask.SetField FieldID:=v_ProjectField_ID, Value:="Some Text or number or date - depending on type"
'Flag field - value has to be set as text, using function BoolToText
P.ProjectSummaryTask.SetField FieldID:=v_ProjectFieldFlag_ID, Value:=BoolToText(True)
'Resource **********************************************************************************
'For sample purposes, set R to first resource if exists
If P.Resources.Count > 0 Then
Set R = P.Resources(1)
v_ResourceField_ID = Application.FieldNameToFieldConstant("MyResourceField", pjResource)
'Flag fields have to be handled in a different way, therefore another variable
v_ResourceFieldFlag_ID = Application.FieldNameToFieldConstant("MyResourceFieldFlag", pjResource)
'Set value for any type - values of flag fields have to be provided as text in your language
R.SetField FieldID:=v_ResourceField_ID, Value:="Some Text or number or date - depending on type"
'Flag field - value has to be set as text, using function BoolToText
R.SetField FieldID:=v_ResourceFieldFlag_ID, Value:=BoolToText(True)
End If
'Task **********************************************************************************
'For sample purposes, set T to first Task if exists
If P.Tasks.Count > 0 Then
Set T = P.Tasks(1)
v_TaskField_ID = Application.FieldNameToFieldConstant("MyTaskField", pjTask)
'Flag fields have to be handled in a different way, therefore another variable
v_TaskFieldFlag_ID = Application.FieldNameToFieldConstant("MyTaskFieldFlag", pjTask)
'Set value for any type - values of flag fields have to be provided as text in your language
T.SetField FieldID:=v_TaskField_ID, Value:="Some Text or number or date - depending on type"
'Flag field - value has to be set as text, using function BoolToText
T.SetField FieldID:=v_TaskFieldFlag_ID, Value:=BoolToText(True)
End If
'Assignment, set Resource field value ***********************************************
'For assignments, we cannot use "GetField". Field values on assignment level can only
'be accessed directly. This is only possible if field name does not contain spaces!!!!
'For sample purposes, set A to first Assignment of first Resource if exists
If P.Resources.Count > 0 Then
Set R = P.Resources(1)
If R.Assignments.Count > 0 Then
Set A = R.Assignments(1)
'Get value for any type - values of flag fields will be provided as text in your language
A.MyResourceField = "Some Text or number or date - depending on type"
'Flag field - value has to be set as text, using function BoolToText
A.MyResourceFieldFlag = BoolToText(True)
End If
End If
'Assignment, set Task field value ***********************************************
'For assignments, we cannot use "GetField". Field values on assignment level can only
'be accessed directly. This is only possible if field name does not contain spaces!!!!
'For sample purposes, set A to first Assignment of first task if exists
If P.Tasks.Count > 0 Then
Set T = P.Tasks(1)
If T.Assignments.Count > 0 Then
Set A = T.Assignments(1)
'Get value for any type - values of flag fields will be provided as text in your language
A.MyTaskField = "Some Text or number or date - depending on type"
'Flag field - value has to be set as text, using function BoolToText
A.MyTaskFieldFlag = BoolToText(True)
End If
End If
End Sub
Function TextToBool(ByVal boolExpression As Variant) As Boolean
'In Project values for flag fields are only available as Yes/No in your language
'This function transforms values to boolean
boolExpression = LCase(boolExpression)
Select Case LCase(boolExpression)
Case True, "ja", "yes", "oui", "si"
TextToBool = True
Case False, "nein", "no", "nee", "" 'empty values as false
TextToBool = False
Case Else
Dim Msg As String
Msg = "MyBool: cannot translate expression of " & boolExpression
Err.Raise Msg
End Select
End Function
Function BoolToText(ByVal boolExpression As Boolean) As String
'In Project values for flag fields are only available as Yes/No in your language
'This function transforms boolean to text value
Select Case Application.LocaleID
Case "1033" 'English
If boolExpression Then
BoolToText = "Yes"
Else
BoolToText = "No"
End If
Case "1031" 'German
If boolExpression Then
BoolToText = "Ja"
Else
BoolToText = "Nein"
End If
Case "1036" 'French
If boolExpression Then
BoolToText = "Oui"
Else
BoolToText = "Non"
End If
Case "1043" 'Dutch
If boolExpression Then
BoolToText = "Ja"
Else
BoolToText = "Nee"
End If
Case Else
Dim Msg As String
Msg = "MyBool: cannot translate expression of " & boolExpression
Err.Raise Msg
End Select
End Function