PS: Mein bisheriger oft geänderter Code:
Aktion:Sub Click(Source As Button)
'*********************************************************************************************************************************
'creates the interface file KOSTT.TXT for the time managment in the same path of database
'*********************************************************************************************************************************
'Invoked from: Initialize of this agent
'used libraries: logging
'used functions: CreateLogEntry(DBName As String, User As String, DesignElement As String, InvokingEvent As String, _
' Text As String)as Boolean
'*********************************************************************************************************************************
'changed: 09.04.2010 - DDorn - verify that files allready imported from the time server side
'*********************************************************************************************************************************
On Error Goto ErrHandle
'*********************************************************************************************************************************
Dim agent As notesagent
Dim profileView As NotesView
Dim profileDoc As NotesDocument
Dim Item As NotesItem
'diyplay to user
Dim AllreadyImported As String
Dim ImportedBy As String
'*********************************************************************************************************************************
Set s = New NotesSession
Set db = s.CurrentDatabase
Set agent = db.GetAgent("InterfaceTime")
Set profileView = db.GetView(lkpProfileView)
Set profileDoc = profileView.GetDocumentByKey(Cstr("ProfileInterfaceTime"))
'-----------------------------------------------------------------------------------------------------------------------------------------------------------------
'create profileDoc if it not exist an set status to 0 to warn other users if they start the action
If profileDoc Is Nothing Then
Set profileDoc = db.CreateDocument
profileDoc.form = "ProfileInterfaceTime"
profileDoc.ImportingUser = s.CommonUserName
profileDoc.FilesAllreadyImported = "0"
Set item = New NotesItem(profileDoc,"ProfileInterfaceTimeAuthors", "[InterfaceData]")
item.IsAuthors = True
Call profileDoc.Save(True,False)
'needed in the first run of this action, if no profileDoc exists
'AllreadyImported = "1"
Else
If profileDoc.FilesAllreadyImported(0) = "0" Then
'don't start the agent
ImportedBy = profileDoc.ImportingUser(0)
AllreadyImported = profileDoc.FilesAllreadyImported(0)
Goto Message
Elseif profileDoc.FilesAllreadyImported(0) = "1" Then
'lock the agent for other users
profileDoc.ImportingUser = s.CommonUserName
profileDoc.FilesAllreadyImported = "0"
Call profileDoc.Save(True,False)
Else
Call CreateLogEntry(db.title,s.CommonUserName,"Aktion: CreateInterfaceTime","Click",_
"Error - Import Status konnte nicht von Profildokument ausgelesen werden")
End If
End If
Set profileDoc = Nothing
'agent decide if it will run or not and write status to profileDoc
Call agent.RunOnServer()
'read the status from the profile doc
Set profileDoc = profileView.GetDocumentByKey(Cstr("ProfileInterfaceTime"))
AllreadyImported = profileDoc.FilesAllreadyImported(0)
Message:
If AllreadyImported = "0" Then
Call CreateLogEntry(db.title,s.CommonUserName,"Aktion: CreateInterfaceTime","Click",_
"Agent läuft bereits - " & " User: " & ImportedBy & " & Status: " & AllreadyImported)
Msgbox "Die Kostenträger werden zur Zeit von " & ImportedBy & " aktualisiert. Bitte probieren Sie es später erneut.",,"Muster GmbH"
Goto Leave
Else
Msgbox "Dateien wurden erstellt! Bitte starten Sie die batch-Datei auf dem Zeitserver um die Kostenträger zu importieren.",,"Muster GmbH"
End If
Leave:
Exit Sub
ErrHandle:
Call CreateLogEntry(db.title,s.CommonUserName,"Aktion: CreateInterfaceTime","Click",_
"Error" & Str(Err) & ": " & Error$ & " in Zeile " & Erl)
Resume Leave
End Sub
Agent - Initialize: '*********************************************************************************************************************************
'Creates the interface files for the time managment in the same path of database. They will copied sheduled by a batch
'file on the time server. If the agent will run manual the batch file on the time server must be started by user.
'*********************************************************************************************************************************
'used libraries: logging
'used functions: CreateLogEntry(DBName As String, User As String, DesignElement As String, InvokingEvent As String, _
' Text As String)as Boolean
'*********************************************************************************************************************************
On Error Goto ErrHandle
'*********************************************************************************************************************************
Dim profileView As NotesView
'*********************************************************************************************************************************
Set s = New NotesSession
Set db = s.CurrentDatabase
Set profileView = db.GetView("lkpProfileDocs")
Set profileDoc = profileView.GetDocumentByKey("ProfileInterfaceTime")
If profileDoc Is Nothing Then
Call CreateLogEntry(db.title,s.CommonUserName,"Agent: InterfaceTime","Initialize",_
"Error - Das Profildokument konnte nicht gefunden werden")
Exit Sub
End If
Call CreateLogEntry(db.title,s.CommonUserName,"Agent: InterfaceTime","Initialize",_
"Profildokument wurde gefunden, prüfe ob Dateien noch nicht importiert wurden")
Call CreateLogEntry(db.title,s.CommonUserName,"Agent: InterfaceTime","Initialize",_
"Profildokument User: " & Cstr(profileDoc.ImportingUser(0)))
Call CreateLogEntry(db.title,s.CommonUserName,"Agent: InterfaceTime","Initialize",_
"Profildokument Status: " & Cstr(profileDoc.FilesAllreadyImported(0)))
If FilesNotImported = True Then
Call CreateLogEntry(db.title,s.CommonUserName,"Agent: InterfaceTime","Initialize",_
"Die Dateien konnten nicht erstellt werden, da ein anderer User die Kostenträger importiert")
Exit Sub
End If
Call CreateLogEntry(db.title,s.CommonUserName,"Agent: InterfaceTime","Initialize",_
"Die Listen für die Zeitwirtschaft werden aktualisiert")
Call CreateKOSTT()
Call CreateCHIPKOSTT()
Call CreateWORKPLACEKOSTT()
Call DeleteMarkedChipAssigns
Call DeleteInterfaceIndicators
Call SetImportStatus
Leave:
Exit Sub
ErrHandle:
Call CreateLogEntry(db.title,s.CommonUserName,"Agent: InterfaceTime","Initialize",_
"Error" & Str(Err) & ": " & Error$ & " in Zeile " & Erl)
Resume Leave
End Sub
Agent - FilesNotImported:Function FilesNotImported As Boolean
'*********************************************************************************************************************************
'check if the files allready imported by the batch file on the time server an write the status to profileDoc for displaying
'status to the user
'*********************************************************************************************************************************
'used libraries: logging
'used functions: CreateLogEntry(DBName As String, User As String, DesignElement As String, InvokingEvent As String, _
' Text As String)as Boolean
'*********************************************************************************************************************************
On Error Goto ErrHandle
'*********************************************************************************************************************************
Dim FileNum As Integer
Dim BatchReturn As Integer
'*********************************************************************************************************************************
FileNum = Freefile()
Open ConditionFile For Input As fileNum
BatchReturn = Input$ (1 , FileNum )
Call CreateLogEntry(DB.title,s.CommonUserName,"Agent: InterfaceTime","FilesNotImported",_
"BatchReturn: " & BatchReturn)
Close FileNum
'set status to profileDoc for display to user
If BatchReturn = "0" Then
profileDoc.FilesAllreadyImported = "0"
Call profileDoc.Save(True,False)
'RETURN
FilesNotImported = True
Else
profileDoc.FilesAllreadyImported = "1"
Call profileDoc.Save(True,False)
'RETURN
FilesNotImported = False
End If
Call CreateLogEntry(DB.title,s.CommonUserName,"Agent: InterfaceTime","FilesNotImported",_
"Profildokument Status:" & Cstr(profileDoc.FilesAllreadyImported(0)))
Leave:
Exit Function
ErrHandle:
Call CreateLogEntry(db.title,s.CommonUserName,"Agent: InterfaceTime","FilesNotImported",_
"Error" & Str(Err) & ": " & Error$ & " in Zeile " & Erl)
'RETURN
FilesNotImported = False
Resume Leave
End Function
Agent - SetImportStatus:Sub SetImportStatus()
'*********************************************************************************************************************************
'if agent is has created the interface files set AllreadyImported to 0, to stop creating new interface file from other users
'*********************************************************************************************************************************
'used libraries: logging
'used functions: CreateLogEntry(DBName As String, User As String, DesignElement As String, InvokingEvent As String, _
' Text As String)as Boolean
'*********************************************************************************************************************************
On Error Goto ErrHandle
'*********************************************************************************************************************************
Filecopy AllreadyImportedFalse, AllreadyImportedNotes
Call CreateLogEntry(db.title,s.CommonUserName,"Agent: InterfaceTime","SetImportStatus",_
"ImportStatus wurde auf 0 gesetzt - .false in .notes kopiert")
Leave:
Exit Sub
ErrHandle:
Call CreateLogEntry(db.title,s.CommonUserName,"Agent: InterfaceTime","SetImportStatus",_
"Error" & Str(Err) & ": " & Error$ & " in Zeile " & Erl)
Resume Leave
End Sub