Option Compare Database Option Explicit '/** ' * Name der Sequenz-Tabelle ' */ Private Const C_SEQ_TABLE As String = "ADDON_SEQUENZ" Private Const C_SEQ_TABLE_HIDDEN As Boolean = True '/** ' * Anweisungen was bei einem create() gemacht werden soll, wenn die Sequenz bereits existiert '*/ Public Enum seqCreateOnExistOptions seqCreateOnExist0 'Mach nix und gib eine 0 zurück seqCreateOnExistLastVal 'Mach nix und gib die aktuelle Nummer zurück seqCreateOnExistNextVal 'Mach nix und gib setze den Squenz um eins hoch seqCreateOnExistReset 'Resete die Sequenz. gibt 1 zurück seqCreateOnExistError 'Raise einen Error End Enum '/** ' * Anweisung wie sich die entsprechende Funktion verhalten soll, wenn die Sequenz noch nicht exisitert Public Enum seqNotExistsOptions seqNotExistCreate 'erstelle die Sequqnz und gib 1 zurück seqNotExist0 'Mach nix und gib eine 0 zurück seqNotExistError 'Raise einen Error End Enum '/** ' * Private Variablen ' */ Private seqName As String Private cachefilterString As String '/** ' * Construktuer ' * @param String Name der Sequenz ' */ Public Sub initMe(ByVal iSeqName As String) seqName = iSeqName End Sub '/** ' * gibt die aktuelle Nummer zurück ' * @param seqNotExistsOptions Anweisung, was bei Nichtexistenz der Sequenz geschehen soll ' * @return Aktueller Wert. Aktuelle Nummer oder 0, je nach iOption ' */ Public Property Get lastVal(Optional ByVal iOption As seqNotExistsOptions = seqNotExist0) As Long If Me.sequenceExists Then lastVal = DMax("last_nr", C_SEQ_TABLE, filterString()) Else lastVal = getSeqNotExists(iOption) End If End Property '/** ' * prüft, ob die Sequenz existiert ' * @return Boolean ' */ Public Property Get sequenceExists() As Boolean sequenceExists = Not (DCount("seq_name", C_SEQ_TABLE, filterString()) = 0) End Property '/** ' * Erstellt die Sequenz ' * @param seqCreateOnExistOptions Angabe was gemacht werden soll, falls die Sequenz bereits exisitert ' * @return eine 1 oder je nach iOption die Aktuelle Sequenznummer oder 0 ' */ Public Function create(Optional ByVal iOption As seqCreateOnExistOptions = seqCreateOnExist0) As Long Dim rs As DAO.Recordset If Me.sequenceExists Then Select Case iOption Case seqCreateOnExist0: create = 0 Case seqCreateOnExistLastVal: create = Me.lastVal Case seqCreateOnExistNextVal: create = calcVal(seqNotExist0) Case seqCreateOnExistError: Call Err.Raise(vbObjectError, "Sequence.create", "Sequenze [" & seqName & "] allredy exists") Case seqCreateOnExistReset: create = Me.reset End Select Else 'Tabelle über DAO öffnen, dmit ich den Record für mich alleine hab Set rs = CurrentDb.OpenRecordset(C_SEQ_TABLE) Call rs.AddNew rs!seq_name = seqName rs!last_nr = 1 rs!last_timestamp = Now() Call rs.Update Call rs.Close Set rs = Nothing create = 1 End If End Function '/** ' * setzt die Sequenz eins weiter ' * @param seqNotExistsOptions Anweisung, was bei Nichtexistenz der Sequenz geschehen soll ' * @return Aktueller Wert. Sequenz-Nr oder 0, je nach iOption ' */ Public Function nextVal(Optional ByVal iOption As seqNotExistsOptions = seqNotExistCreate) As Long nextVal = calcVal(iOption) End Function '/** ' * setzt die Sequenz auf 1 zurück ' * @param seqNotExistsOptions Anweisung, was bei Nichtexistenz der Sequenz geschehen soll ' * @return Aktueller Wert. 1 oder 0, je nach iOption ' */ Public Function reset(Optional ByVal iOption As seqNotExistsOptions = seqNotExistCreate) As Long reset = calcVal(iOption, 1) End Function '/** ' * Löscht die Sequenz ' */ Public Sub delete() Call CurrentDb.execute("DELETE * FROM [" & C_SEQ_TABLE & "] WHERE " & filterString()) End Sub '/** ' * Den SQL-Filter für den Tabellenzugriff ' * @return String SQL-Filter ' */ Private Function filterString() As String If Nz(cachefilterString) = vbNullString Then cachefilterString = "[seq_name] = '" & seqName & "'" filterString = cachefilterString End Function '/** ' * Handlet den Fall, dass die Sequenz noch nicht exisitert ' * @param seqNotExistsOptions Anleitung was gemacht werden soll ' * @return Long ' */ Private Function getSeqNotExists(ByVal iOption As seqNotExistsOptions) As Long Select Case iOption Case seqNotExistCreate: getSeqNotExists = Me.create Case seqNotExist0: getSeqNotExists = 0 Case seqNotExistError: Call Err.Raise(vbObjectError, "Sequence", "Sequenze [" & seqName & "] not exists") End Select End Function '/** ' * setzt die neue Nummer ' * @param Long Es kann eine Nummer vorgegeben werden. Dann wird die Sequenz auf diese Nummer gesetzt ' * @return Long Aktuelle neue Nummer ' */ Private Function calcVal(ByVal iOption As seqNotExistsOptions, Optional ByVal iNr As Long = 0) Dim rs As DAO.Recordset If Me.sequenceExists Then Set rs = CurrentDb.OpenRecordset(C_SEQ_TABLE) rs.index = "IDX_SEQ_NAME" Call rs.Seek("=", seqName) calcVal = IIf(iNr = 0, rs!last_nr + 1, iNr) Call rs.Edit rs!last_nr = calcVal rs!last_timestamp = Now() Call rs.Update Call rs.Close Set rs = Nothing Else calcVal = getSeqNotExists(iOption) End If End Function '/** ' * Erstellt die Sequenztabelle falls diese noch nicht exisitert ' */ Private Sub createSequenceTable() 'Prüfen ob die Tabelle existiert If DCount("*", "MSysObjects", "[name] = '" & C_SEQ_TABLE & "'") = 0 Then 'Tabelle erstellen Call CurrentDb.execute("CREATE TABLE " & C_SEQ_TABLE & "(SEQ_NAME CHAR(255) NOT NULL, LAST_NR LONG NOT NULL, LAST_TIMESTAMP DATETIME)") 'Unique Index 'IDX_SEQ_NAME' erstellen Call CurrentDb.execute("CREATE UNIQUE INDEX IDX_SEQ_NAME ON " & C_SEQ_TABLE & " (SEQ_NAME) WITH PRIMARY") End If 'Tabelle in der Objektübersicht auf Hidden stellen Call Application.SetHiddenAttribute(acTable, C_SEQ_TABLE, C_SEQ_TABLE_HIDDEN) End Sub '/** ' * Initializeire die Klasse. Prüfen ob die zugrundeliegende Tabelle existiert ' */ Private Sub Class_Initialize() Call createSequenceTable End Sub