paddy69
09-24-2007, 07:47 AM
I have created a macro to control the behaviour of MSP 2007. Unfortunately this is a very slow procedure. Is there anyone who can help me with the code to improve the performance? I'm not sure but is there a way to work with a buffer in VBA?
Thanks,
Patrick.
Public Sub SET_BEFORE_SAVE()
On Error GoTo ExitSub
Dim P As Integer
Dim PA As Integer
Dim T As Integer
With ActiveProject
Set MyTask = .Tasks
T = .Tasks.Count
For P = 1 To T
If Not .Tasks(P) Is Nothing And MyTask(P).Summary = False Then
If MyTask(P).GetField(FieldNameToFieldConstant("On Schedule")) = "Yes" Then
' Set Publish flag als On Schedule = YES of als User Status contains "TOS"
Dim SearchString As String, SearchChar As String
SearchString = MyTask(P).GetField(FieldNameToFieldConstant("User Status"))
SearchChar = " TOS "
If InStr(SearchString, SearchChar) > 0 Then
MyTask(P).IsPublished = True
Else
MyTask(P).IsPublished = False
End If
' Check "task type" en "effort driven"
If MyTask(P).Type = 1 Then 'Fixed Duration
MyTask(P).Type = 0 'Fixed Units
End If
' Set Assignment Data
For PA = 1 To MyTask(P).Assignments.Count
.Tasks(P).Assignments(PA).Text1 = "WvG: " & .Tasks(P).GetField(FieldNameToFieldConstant("Remark"))
Next PA
Else
MyTask(P).IsPublished = False
If MyTask(P).Type = 0 Then 'Fixed Units
MyTask(P).Type = 1 'Fixed Duration
MyTask(P).EffortDriven = False
End If
End If
End If
Next P
' Rename Assignment Custom Field Text1 into Werkvergunning
CustomFieldRename FieldID:=pjCustomTaskText1, NewName:="Werkvergunning"
End With
ExitSub:
End Sub
Thanks,
Patrick.
Public Sub SET_BEFORE_SAVE()
On Error GoTo ExitSub
Dim P As Integer
Dim PA As Integer
Dim T As Integer
With ActiveProject
Set MyTask = .Tasks
T = .Tasks.Count
For P = 1 To T
If Not .Tasks(P) Is Nothing And MyTask(P).Summary = False Then
If MyTask(P).GetField(FieldNameToFieldConstant("On Schedule")) = "Yes" Then
' Set Publish flag als On Schedule = YES of als User Status contains "TOS"
Dim SearchString As String, SearchChar As String
SearchString = MyTask(P).GetField(FieldNameToFieldConstant("User Status"))
SearchChar = " TOS "
If InStr(SearchString, SearchChar) > 0 Then
MyTask(P).IsPublished = True
Else
MyTask(P).IsPublished = False
End If
' Check "task type" en "effort driven"
If MyTask(P).Type = 1 Then 'Fixed Duration
MyTask(P).Type = 0 'Fixed Units
End If
' Set Assignment Data
For PA = 1 To MyTask(P).Assignments.Count
.Tasks(P).Assignments(PA).Text1 = "WvG: " & .Tasks(P).GetField(FieldNameToFieldConstant("Remark"))
Next PA
Else
MyTask(P).IsPublished = False
If MyTask(P).Type = 0 Then 'Fixed Units
MyTask(P).Type = 1 'Fixed Duration
MyTask(P).EffortDriven = False
End If
End If
End If
Next P
' Rename Assignment Custom Field Text1 into Werkvergunning
CustomFieldRename FieldID:=pjCustomTaskText1, NewName:="Werkvergunning"
End With
ExitSub:
End Sub