Private
Sub
NOTE_AfterUpdate()
Dim
DB
As
Database, DB1
As
Database
Dim
T
As
Recordset, abfrage
As
QueryDef
Dim
d
As
Recordset, D1
As
Recordset
Dim
Anzahl
As
Integer
Dim
sqlalt
As
String
, sqlneu
As
String
, laenge
As
Integer
Dim
ref_nr
As
Long
, pos
On
Error
GoTo
Fehler
Set
DB1 = DBEngine(0)(0)
Set
DB = DBEngine.Workspaces(0).OpenDatabase(g_Dname())
Set
abfrage = DB1.QueryDefs(
"AB_Beurteilung"
)
sqlalt = abfrage.sql
laenge = Len(sqlalt)
pos = InStr(1, sqlalt,
"P"
)
sqlneu = Left$(sqlalt, pos - 1) + REF + Right$(sqlalt, laenge - pos)
abfrage.sql = sqlneu
Set
d = abfrage.OpenRecordset(dbOpenDynaset)
abfrage.sql = sqlalt
abfrage.Close
Set
abfrage = DB1.CreateQueryDef(
"Zählen"
)
abfrage.sql =
"SELECT COUNT(NR) AS ZAHL FROM beurteilung WHERE beurteilung.ref ="
& REF
Set
D1 = abfrage.OpenRecordset(dbOpenDynaset)
Anzahl = D1.zahl
abfrage.Close
DB1.QueryDefs.Delete
"Zählen"
D1.Close
d.MoveLast
If
Anzahl <= 3
And
d![NOTE] = NOTE
Then
MsgBox
"Sie haben die gleiche Note noch einmal eingegeben!"
& Chr(13) & Chr(10) &
"Bitte einen Augenblick warten."
& Chr(13) & Chr(10) &
"Der Datensatz wird gelöscht."
DoCmd.Requery
d.Close
ref_nr = Abfrage_Beurteilung()
Set
T = DB.OpenRecordset(
"beurteilung"
, dbOpenTable)
T.Index =
"PrimaryKey"
T.Seek
"="
, ref_nr
T.Delete
T.Close
DoCmd.Requery
DoCmd.GoToRecord , , A_NEWREC
ElseIf
Anzahl = 3
And
d![NOTE] <> NOTE
Then
MsgBox
"Mit dieser Neueingabe wird der älteste"
& Chr(13) & Chr(10) &
"Datensatz gelöscht."
& Chr(13) & Chr(10) &
"Bitte einen Augenblick warten."
d.MoveFirst
d.Delete
DoCmd.Requery
DoCmd.GoToRecord , , A_NEWREC
End
If
DB.Close
Fehler:
Exit
Sub
End
Sub