Sub CreateRepeatingEntry ()
'==================================================================================================================
' Purpose: Creates repeating time registration entries
'------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
' Arguments: Nothing
'------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
' Returns: Nothing
'------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
' Created by: Bernhard Koehler on 14.12.2004 Modified by: Bernhard Koehler on 09.11.2007
'------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
' Changes: BK on 17.12.2004 - enhance the tests for IsFreeTime and CheckOrderValidity
' BK on 21.12.2004 - Add the items Department and Region
' BK on 22.12.2004 - Add the DocID
' BK on 03.01.2005 - Correct the items names to read department and region from the global setup document
' BK on 27.01.2005 - Add CostCenter details from the order
' BK on 09.11.2007 - Replace "StartWeekday" with "StartDateWeekday"
'==================================================================================================================
Const VIEW_ORDERS_NAME = "(LookupOrderByNumbers)"
Const RULE_ALLDAY = "1"
Const RULE_PARTDAY = "2"
Const RULE_FLEXDAY = "3"
Dim ws As New NotesUIWorkspace
Dim session As New NotesSession
Dim dbCurrent As NotesDatabase
Dim dbConfig As NotesDatabase
Dim viewLookupOrders As NotesView
Dim docSetup As NotesDocument
Dim docOrder As NotesDocument
Dim docDialog As NotesDocument
Dim docTemp As NotesDocument
Dim docEntry As NotesDocument
Dim itemAccess As NotesItem
Dim szErrorMessage As String
Dim vLoop As Variant
Dim vTemp As Variant
Dim dblWorkingHours As Double
On Error Goto ErrorRoutine
'The preliminary settings:
Set dbCurrent = session.CurrentDatabase
Set docSetup = GetSetupDocument (True, "Global Setup", szErrorMessage)
If docSetup Is Nothing Then
Exit Sub
End If
'Check for a correct setup (the worktime per date area):
If CheckGlobalSetup (True, docSetup, szErrorMessage) = False Then
Exit Sub
End If
'Get a dialog box to retrieve the user's data:
Set docDialog = dbCurrent.CreateDocument
docDialog.Form = "(DialogDateRangeEntry)"
docDialog.TRUser = docSetup.TRUserName (0)
docDialog.TRCreator = session.UserName
docDialog.Department = docSetup.TRDepartment
docDialog.Region = docSetup.TRRegion
If ws.DialogBox ("(DialogDateRangeEntry)", True, True, False, False, False, False, "Mehrtägige Zeiterfassung", docDialog, True, False) = False Then
Exit Sub 'The user pressed Escape and canceled the action !
End If
'Get the order document:
Set dbConfig = GetDBConfig (True, szErrorMessage)
If dbConfig Is Nothing Then
Exit Sub
End If
Set viewLookupOrders = dbConfig.GetView (VIEW_ORDERS_NAME)
If viewLookupOrders Is Nothing Then
Messagebox "Die Ansicht '" & VIEW_ORDERS_NAME & "' wurde in der Auftrags-DB nicht gefunden !" & MSG_INFORM_ADMIN, MB_ICONEXCLAMATION, "Fehler"
Exit Sub
End If
Set docOrder = viewLookupOrders.GetDocumentByKey (docDialog.OrderNo (0), True)
If docOrder Is Nothing Then
Messagebox "Der gewählte Auftrag Nr. " & docDialog.OrderNo (0) & " konnte nicht geöffnet werden !" & MSG_INFORM_ADMIN, MB_ICONEXCLAMATION, "Fehler"
Exit Sub
End If
'Make the necessary checks before creating new documents:
Set docTemp = Nothing
Set docTemp = dbCurrent.CreateDocument
docTemp.TRUser = docDialog.TRUser
docTemp.OrderNo = docDialog.OrderNo
docTemp.StartDate = docDialog.StartDate
docTemp.StartTime = docDialog.StartTime
docTemp.EndTime = docDialog.EndTime
'Loop through the given date range and make the necessary checks:
For vLoop = docDialog.StartDate (0) To docDialog.EndDate (0) Step 1
'Get the standard working hours for the current weekday:
vTemp = docSetup.GetItemValue ("Hours" & Cstr (Weekday (vLoop)))
dblWorkingHours = vTemp (0)
If (dblWorkingHours > 0) Or docOrder.OrderDateRangeRule (0) = RULE_FLEXDAY Then 'Build entries only for working days except for orders with FLEXDAY rule!
If docOrder.OrderDateRangeRule (0) = RULE_ALLDAY Then 'Build a new start and end time:
docTemp.StartTime = Timenumber (8, 0, 0)
docTemp.EndTime = docDialog.StartTime (0) + (dblWorkingHours / 24)
End If
docTemp.StartDate = vLoop
Call NormalizeStartEndTime (docTemp)
If IsFreeTime (False, docTemp, szErrorMessage) = False Then
Messagebox "Die Einträge können nicht erstellt werden, weil:" & Chr$ (10) & szErrorMessage & Chr$ (10) & Chr$ (10) &_
"Die Operation wurde gestoppt !"
Exit Sub
End If
If CheckOrderValidity (False, docTemp, szErrorMessage) = False Then
Messagebox "Die Einträge können nicht erstellt werden, weil:" & Chr$ (10) & szErrorMessage & Chr$ (10) & Chr$ (10) &_
"Die Operation wurde gestoppt !"
Exit Sub
End If
End If 'of "If (dblWorkingHours > 0) Or docOrder.OrderDateRangeRule (0) = RULE_FLEXDAY Then"
Next
'Loop through the given date range to create repeating entries:
For vLoop = docDialog.StartDate (0) To docDialog.EndDate (0) Step 1
'Get the standard working hours for the current weekday:
vTemp = docSetup.GetItemValue ("Hours" & Cstr (Weekday (vLoop)))
dblWorkingHours = vTemp (0)
'Check if the given day is a red letter day:
Dim vWorkingDays As Variant 'An array of the user's working days - we don't use this functionality of function GetWorkingAndRedLetterDays
Dim vRedLetterDates As Variant
Dim vRedLetterDayNames As Variant
Dim dblWorkingDays As Double
dblWorkingDays = GetWorkingAndRedLetterDays (vLoop, vLoop, docDialog.Region (0), vWorkingDays, vRedLetterDates, vRedLetterDayNames)
If dblWorkingDays = 0 Then
dblWorkingHours = 0
Else
If dblWorkingDays < 1 Then
dblWorkingHours = dblWorkingHours * dblWorkingDays 'for partial red letter days ...
End If
End If
If (dblWorkingHours > 0) Or docOrder.OrderDateRangeRule (0) = RULE_FLEXDAY Then 'Build entries only for working days except for orders with FLEXDAY rule!
If docOrder.OrderDateRangeRule (0) = RULE_ALLDAY Then 'Build a new start and end time:
docDialog.StartTime = Timenumber (8, 0, 0)
docDialog.EndTime = docDialog.StartTime (0) + (dblWorkingHours / 24)
End If
'Create the time registration document:
Set docEntry = dbCurrent.CreateDocument
docEntry.Form = "TimeRegistration"
docEntry.DocID = docEntry.UniversalID
docEntry.TRUser = docDialog.TRUser
docEntry.TRCreator = docDialog.TRCreator
docEntry.Department = docDialog.Department
docEntry.Region = docDialog.Region
docEntry.Order = docDialog.Order
docEntry.OrderNo = docDialog.OrderNo
docEntry.CostCenterNo = docDialog.CostCenterNo
docEntry.CostCenterDescription = docDialog.CostCenterDescription
docEntry.Customer = docDialog.Customer
docEntry.Location = docDialog.Location
docEntry.Activity = docDialog.Activity
docEntry.Description = docDialog.Description
If docEntry.Description (0) = "" Then docEntry.Description = docDialog.Activity
docEntry.StartDate = vLoop
docEntry.StartTime = vLoop + docDialog.StartTime (0)
docEntry.EndTime = vLoop + docDialog.EndTime (0)
docEntry.Duration = GetTimeDifferenceMin (docEntry.StartTime (0), docEntry.EndTime (0))
docEntry.StartDateWeekday = g_WeekdayNames (Weekday (docEntry.StartDate (0)))
docEntry.WeekNo = CalculateWeekNo (docEntry.StartDate (0))
'Set the author and reader access:
docEntry.AllowedAuthors = ArrayAdd ("[Administrator]", "[TREditor]")
Set itemAccess = docEntry.GetFirstItem ("AllowedAuthors")
itemAccess.IsAuthors = True
docEntry.AllowedReaders = ArrayAdd ("[Administrator]", "[TRReader]")
Set itemAccess = docEntry.GetFirstItem ("AllowedReaders")
itemAccess.IsReaders = True
Call StoreVersionNo (docEntry)
Call UpdateHistory (docEntry, "Erstellt", 10)
docEntry.DTSaved = Now
Call SetTRUserNameChanges (docEntry)
Call docEntry.Save (True, False, True)
Print "Eintrag erstellt für den " & Cstr (docEntry.StartDate (0)) & " von " & Cstr (docEntry.StartTime (0)) & " bis " & Cstr (docEntry.EndTime (0))
End If 'of "If (dblWorkingHours > 0) Or docOrder.OrderDateRangeRule (0) = RULE_FLEXDAY"
Next
'Clear the status bar:
Print
'Refresh the view:
Call ws.ViewRefresh
Exit Sub
ErrorRoutine:
Call ErrorHandler ("CreateRepeatingTREntries")
Exit Sub
End Sub