hallo zusammen,
bei datenbankscritp bei querydocumentdelete fogendes eingeben
If Source.Documents.Count > 0 Then
Msgbox "Verwenden Sie bitte den Befehl 'Löschen' im Dokument!", 48,"Raiffeisen"
continue = False
Exit Sub
End If
damit generell die löschtaste nicht verwendet werden kann
anschließend in den masken eine schaltfläche mit folgenden script einbauen
gebe dir aus meiner projektdb eine prozedur (einfach nur das verwenden was du brauchst
schönen tag pippo
****************************************
Sub RemoveDoc(Doc As NotesDocument, UIDoc As NotesUIDocument, RWert As Integer)
REM Löschen von Dokumenten
Dim ws As New NotesUIWorkspace
Dim db As NotesDatabase
Dim session As New NotesSession
Dim userName As NotesName
Dim NotRemove As Integer
Set userName = session.CreateName(session.UserName)
Set db = session.CurrentDatabase
Dim tmpEffBeg As Variant, tmpProID As String, tmpProArt As String
tmpProArt= doc.ProArt(0)
tmpProID = doc.ProID(0)
REM Effektiver Beginn
If doc.Form(0) = "frmProjekt" Then
REM Projekt
tmpEffBeg = doc.ProEffBeg(0)
Elseif doc.Form(0) = "frmPhase" Then
REM Phase
tmpEffBeg = doc.PhaEffBeg(0)
Elseif doc.Form(0) = "frmAufgabe" Then
REM Aufgabe
tmpEffBeg = doc.AufEffBeg(0)
Elseif doc.Form(0) = "frmTagAufwand" Then
REM Tagesaufwand
tmpEffBeg = ""
Else
Msgbox "Fehler: Prozedur kann nicht von diesem Form aus gestartet werden!"
RWert =1
Exit Sub
End If
NotRemove=0
REM Nur LPH darf Projekt löschen
If doc.Form(0) = "frmProjekt" Then
Dim tmpRolle
REM Kontrolle SUPERVISOR
tmpRolle = Evaluate("@IsMember('[SUPERVISOR]';@UserRoles)")
If tmpRolle(0) = 1 Then
Goto WeiterSupervisor
End If
REM Kontrolle LPH
tmpRolle = Evaluate("@IsMember('[LPH]';@UserRoles)")
If tmpRolle(0) = 0 Then
Msgbox "Nur Lösungsphilosophen sind berechtigt Projekte zu löschen!" , 48, "Raiffeisen"
RWert =1
Exit Sub
End If
End If
WeiterSupervisor:
REM Bei Neu darf nicht gelöscht werden
If UIDoc.IsNewDoc = True Then
Msgbox "Bei Neu darf nicht gelöscht werden!" , 48, "Raiffeisen"
RWert =1
Exit Sub
End If
REM Phase 0 und Aufgaben 0 können nur von Supervosor gelöscht werden
REM Kontrolle SUPERVISOR
tmpRolle = Evaluate("@IsMember('[SUPERVISOR]';@UserRoles)")
If tmpRolle(0) = 0 Then
REM Phase
If doc.Form(0) = "frmPhase" Then
If doc.PhaNr(0) = 0 Then
Msgbox "Sie sind nicht berechtigt Phase 0 zu löschen!" , 48, "Raiffeisen"
RWert =1
Exit Sub
End If
End If
REM Aufgabe
If doc.Form(0) = "frmAufgabe" Then
If doc.AufNr(0) = 0 And doc.ProArt(0) <> "30" Then
Msgbox "Sie sind nicht berechtigt Aufgabe 0 zu löschen!" , 48, "Raiffeisen"
RWert =1
Exit Sub
End If
End If
End If
REM Status wird kontrolliert
If doc.Form(0) <> "frmTagAufwand" Then
If tmpProArt <> "10" And tmpProArt <> "30" Then
Msgbox "Nur Projektanforderugen oder Wartungsprojekte können gelöscht werden!" , 48, "Raiffeisen - Löschen nicht möglicht!"
RWert =1
Exit Sub
End If
End If
REM Kontrolle Ob User Berechtigung hat<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
If UIDoc.IsNewDoc = False Then
Dim Continue As Variant
Call KontrolleRemoveForm(doc, Continue)
If Continue = False Then Exit Sub
Else
Exit Sub
End If
REM Effektiver Beginn wird kontrolliert
Dim txtMsgbox As String
txtMsgbox=""
If tmpEffBeg <> "" Then
If doc.Form(0) = "frmProjekt" Then
txtMsgbox="Für das Projekt wurden bereits Tagesaufwände erfasst! Projekt kann nicht gelöscht werden"
Elseif doc.Form(0) = "frmPhase" Then
txtMsgbox="Für die Phase wurden bereits Tagesaufwände erfasst! Phase kann nicht gelöscht werden"
Elseif doc.Form(0) = "frmAufgabe" Then
txtMsgbox="Für die Aufgabe wurden bereits Tagesaufwände erfasst! Aufgabe kann nicht gelöscht werden"
End If
Msgbox txtMsgbox , 48, "Raiffeisen - Löschen nicht möglicht!"
RWert =1
Exit Sub
End If
REM Löschen Ja - Nein
txtMsgbox=""
If doc.Form(0) = "frmProjekt" Then
txtMsgbox="Möchten Sie das Projekt und alle seine Phasen und Aufgaben wirklich löschen?"
Elseif doc.Form(0) = "frmPhase" Then
txtMsgbox="Möchten Sie die Phase und alle ihre Aufgaben wirklich löschen?"
Elseif doc.Form(0) = "frmAufgabe" Then
txtMsgbox="Möchten Sie die Aufgabe wirklich löschen?"
Elseif doc.Form(0) = "frmTagAufwand" Then
txtMsgbox="Möchten Sie den Tagesaufwand wirklich löschen?"
End If
If Msgbox (txtMsgbox,36,"Raiffeisen") = 7 Then
Exit Sub
End If
If userName.Common <> "Franz Rauch" Then
'Msgbox "i moches grod... :-)"
'Exit Sub
End If
Dim curTag As NotesDocument, curAuf As NotesDocument, curPha As NotesDocument, curPro As NotesDocument
Dim allTag As NotesDocumentCollection, allAuf As NotesDocumentCollection, allPha As NotesDocumentCollection
Dim item As NotesItem, LockName As NotesName
REM Profildocument wird gesucht für Servername und Filename von Dok
Dim tmpProfile As NotesDocument
Set tmpProfile = db.GetProfileDocument("Profile_Pro")
REM Projektdb wird neu geöffnet, um Änderungen eines anderen Users zu erkennen
Dim dbLock As New NotesDatabase( "", "" )
Dim tmpForm As String
REM Projektdatenbank wird geöffnet, über Profile
If dbLock.OpenByReplicaID(tmpProfile.ServerPro(0) ,Left(tmpProfile.RepIDPro(0),8) & Right(tmpProfile.RepIDPro(0),8) ) Then
REM Msgbox dbLock.Title & " gefunden..."
Else
Msgbox "Prokejtdb nicht gefunden..."
RWert=1
Exit Sub
End If
REM Jetzt wird Projekt gesucht - backend
Set curPro = dbLock.GetDocumentByUNID( tmpProID )
If curPro.LockUser(0)="" Then
curPro.LockUser = userName.Canonical
Call curPro.Save(True,False)
curPro.LockUserDT =curPro.LastModified
Call curPro.Save(True,False)
REM Msgbox "Projekt von " & userName.Canonical & " gesperrt..." & curPro.Form(0) & curPro.LockUser(0)
Else
Set LockName = session.CreateName(curPro.LockUser(0))
Msgbox "Projekt " & curPro.ProName(0) & " kann nicht gelöscht werden! Wird von " & LockName.Common & " bearbeitet!",48,"Raiffeisen"
RWert=1
Exit Sub
End If
Dim PhaNr As Integer, AufNr As Integer
If doc.Form(0) = "frmProjekt" Then
REM Suche Phasen
Set allPha= curPro.Responses
If AllPha.count > 0 Then
For PhaNr = 1 To AllPha.count
Set curPha = allPha.GetNthDocument(PhaNr)
REM Suche Aufgaben
Set allAuf= curPha.Responses
If AllAuf.count > 0 Then
For AufNr = 1 To AllAuf.count
Set curAuf = allAuf.GetNthDocument(AufNr)
REM Suche Tagesaufwände
Set allTag= curAuf.Responses
If allTag.count =0 Then
REM Bei Aufgabe Wartung wird nun das HotlineDoc gesucht und Status zurückgesetzt
If curAuf.HasItem( "HotLID" ) Then
Call AktDocHotlineWR(session , db ,curAuf ,RWert)
If RWert =1 Then
Exit Sub
End If
End If
REM Aufgabe wird gelöscht
Call curAuf.Remove(True)
Else
Msgbox "Fehler! Sie versuchen Dokumente eines Projektes zu löschen wo bereits Tagesaufwände erfasst wurden!",48,"Raiffeisen"
RWert=1
NotRemove=1
Goto Ende
End If
Next
End If
REM Phase wird gelöscht
Call curPha.Remove(True)
Next
End If
Elseif doc.Form(0) = "frmPhase" Then
REM Aktuelle Phase
Set curPha = doc
REM Suche Aufgaben
Set allAuf= curPha.Responses
If AllAuf.count > 0 Then
For AufNr = 1 To AllAuf.count
Set curAuf = allAuf.GetNthDocument(AufNr)
REM Suche Tagesaufwände
Set allTag= curAuf.Responses
If allTag.count =0 Then
REM Bei Aufgabe Wartung wird nun das HotlineDoc gesucht und Status zurückgesetzt
If curAuf.HasItem( "HotLID" ) Then
Call AktDocHotlineWR(session , db ,curAuf ,RWert)
If RWert =1 Then
Exit Sub
End If
End If
REM Aufgabe wird gelöscht
Call curAuf.Remove(True)
Else
Msgbox "Fehler! Sie versuchen Dokumente eines Projektes zu löschen wo bereits Tagesaufwände erfasst wurden!",48,"Raiffeisen"
RWert=1
NotRemove=1
Goto Ende
End If
Next
End If
Elseif doc.Form(0) = "frmAufgabe" Then
REM Aktuelle Aufgabe
Set curAuf = doc
REM Suche Tagesaufwände
Set allTag= curAuf.Responses
If allTag.count > 0 Then
Msgbox "Fehler! Sie versuchen Dokumente eines Projektes zu löschen wo bereits Tagesaufwände erfasst wurden!",48,"Raiffeisen"
RWert=1
NotRemove=1
Goto Ende
End If
Elseif doc.Form(0) = "frmTagAufwand" Then
REM OK
End If
Ende:
If NotRemove=0 Then
Dim BackEndDoc As notesDocument
REM Aktives Doc wird geschlossen
UIDoc.close
If doc.Form(0) = "frmProjekt" Then
REM Nun wird Projekt gelöscht
Call curPro.Remove(True)
Elseif doc.Form(0) = "frmPhase" Then
REM Nun wird Phase gelöscht
Set BackEndDoc = dbLock.GetDocumentByUNID( Doc.PhaID(0) )
Call BackEndDoc.Remove(True)
Elseif doc.Form(0) = "frmAufgabe" Then
REM Nun wird Aufgabe gelöscht
Set BackEndDoc = dbLock.GetDocumentByUNID( Doc.AufID(0) )
REM Bei Aufgabe Wartung wird nun das HotlineDoc gesucht und Status zurückgesetzt
If BackEndDoc.HasItem( "HotLID" ) Then
Call AktDocHotlineWR(session , db ,BackEndDoc ,RWert)
If RWert =1 Then
Exit Sub
End If
End If
Call BackEndDoc.Remove(True)
Elseif doc.Form(0) = "frmTagAufwand" Then
REM Nun wird gelöscht
Set BackEndDoc = dbLock.GetDocumentByUNID( Doc.TagID(0) )
Call BackEndDoc.Remove(True)
End If
End If
REM Projektsperre wird aufgehoben
If NotRemove=1 Then
Msgbox "Projekt konnte nicht gelöscht werden!",48,"Raiffeisen"
End If
If doc.Form(0) <> "frmProjekt" Or NotRemove=1 Then
If doc.Form(0) = "frmTagAufwand" Then
REM Projekt wird aktualisiert, damit Summen und Datum stimmt
REM Hier wird Projektsperre in Funktion aufgehoben
Call AktPro(doc.AufID(0), doc.PhaID(0), doc.ProID(0), "","Ja")
Call ws.viewrefresh()
Exit Sub
Elseif doc.Form(0) = "frmAufgabe" Then
REM Projekt wird aktualisiert, damit Summen und Datum stimmt
REM Kontrolle ob Phase noch eine Aufgabe hat
REM Aufgabe Ja > Projekt wird mit dieser Aufgabe aktualisiert > OK(Exit) 1
REM Aufgabe Nein > Phase Daten auf NULL 2
REM Kontrolle ob es weitere Phasen und Aufgaben gibt 3
REM Weitere Pha und Auf Ja: suche Auf - Pro aktualisieren > OK (Exit) 4
REM es gibt keine Auf > Daten von Pro auf Null 5
REM 1
Set curPha = dbLock.GetDocumentByUNID( Doc.PhaID(0) )
REM Suche Aufgaben
Set allAuf= curPha.Responses
If AllAuf.count > 0 Then
For AufNr = 1 To AllAuf.count
Set curAuf = allAuf.GetNthDocument(AufNr)
REM Aufgabe gefunden; nun wird Projekt aktualisert und Programm verlassen
REM Hier wird Projektsperre in Funktion aufgehoben
Call AktPro(curAuf.AufID(0), curAuf.PhaID(0), curAuf.ProID(0), "","Ja")
Call ws.viewrefresh()
Exit Sub
Next
Else
REM 2
curPha.PhaGepBeg=""
curPha.PhaGepEnd=""
curPha.PhaEffBeg=""
curPha.PhaEffEnd=""
curPha.PhaGepAufW=""
curPha.PhaGepAufWT=""
curPha.PhaEffAufW=""
curPha.PhaEffAufWT=""
curPha.PhaErlPro=""
curPha.PhaGepAufWT=""
curPha.PhaEffAufWT=""
curPha.IcoB=""
curPha.IcoT=""
Call curPha.Save( True, False)
End If
REM 3
Set allPha= curPro.Responses
If AllPha.count > 0 Then
For PhaNr = 1 To AllPha.count
Set curPha = allPha.GetNthDocument(PhaNr)
REM Suche Aufgaben
Set allAuf= curPha.Responses
If AllAuf.count > 0 Then
For AufNr = 1 To AllAuf.count
Set curAuf = allAuf.GetNthDocument(AufNr)
REM 4
REM Aufgabe gefunden; nun wird Projekt aktualisert und Programm verlassen
REM Hier wird Projektsperre in Funktion aufgehoben
Call AktPro(curAuf.AufID(0), curAuf.PhaID(0), curAuf.ProID(0), "","Ja")
Call ws.viewrefresh()
Exit Sub
Next
End If
Next
End If
REM 5
curPro.ProGepBeg=""
curPro.ProGepEnd=""
curPro.ProEffBeg=""
curPro.ProEffEnd=""
curPro.ProGepAufW=""
curPro.ProEffAufW=""
curPro.ProErlPro=""
curPro.ProGepAufWT=""
curPro.ProEffAufWT=""
curPro.IcoB=""
curPro.IcoT=""
Call curPro.Save( True, False)
Elseif doc.Form(0) = "frmPhase" Then
REM Projekt wird aktualisiert, damit Summen und Datum stimmt
REM Kontrolle ob es Phasen mit Aufgabe gibt
REM Aufgbe Ja > Projekt wird mit dieser Aufgabe aktualisiert > OK(Exit) 1
REM Aufgbe Nein > Daten von Pro auf NULL 2
REM 1
Set allPha= curPro.Responses
If AllPha.count > 0 Then
For PhaNr = 1 To AllPha.count
Set curPha = allPha.GetNthDocument(PhaNr)
REM Suche Aufgaben
Set allAuf= curPha.Responses
If AllAuf.count > 0 Then
For AufNr = 1 To AllAuf.count
Set curAuf = allAuf.GetNthDocument(AufNr)
REM 4
REM Aufgabe gefunden; nun wird Projekt aktualisert und Programm verlassen
REM Hier wird Projektsperre in Funktion aufgehoben
Call AktPro(curAuf.AufID(0), curAuf.PhaID(0), curAuf.ProID(0), "","Ja")
Call ws.viewrefresh()
Exit Sub
Next
End If
Next
End If
REM 2
curPro.ProGepBeg=""
curPro.ProGepEnd=""
curPro.ProEffBeg=""
curPro.ProEffEnd=""
curPro.ProGepAufW=""
curPro.ProEffAufW=""
curPro.ProErlPro=""
curPro.ProGepAufWT=""
curPro.ProEffAufWT=""
curPro.IcoB=""
curPro.IcoT=""
Call curPro.Save( True, False)
End If
REM Sperre wird aufgehoben
curPro.LockUser=""
Call curPro.Save( True, False)
curPro.LockUserDT=curPro.LastModified
Call curPro.Save( True, False)
End If