Project Online / Project Server: Lesen und Schreiben von Benutzerdefinierte Enterprise-Feldern / Read and Write Enterprise Custom Fields

2019-05-27 | Barbara.Henhapl
  1. Deutsch
  2. English
  3. Code

Deutsch

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:

In Makros implementieren / Implement Macros wird beschrieben, wie ein Makro in Project übernommen werden kann. Mehr Beispielmakros sind unter VBA zu finden.

English

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:

Implementing Macros / Implement Macros describes how to apply a macro to Project. More sample code is available at VBA.

Code

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
    

Categories: VBA, Project

Source: https://blog.atwork.at/post/2019/05/27/Project-Lesen-und-Schreiben-von-Benutzerdefinierte-Enterprise-Feldern-Read-and-Write-Enterprise-Custom-Fields