Ich vermisse in MS Access die Möglichkeiten von Sequenzen. Darum habe ich mir eine Sequenz-Klasse gebaut.. Die Sequenzen werden in einer Hilfstabelle gespeichert. Standardmässig heisst diese ADDON_SEQUENZ. Der Name kann aber in der Klasse angepasst werden (Konstante C_SEQ_TABLE abändern) Um die Tabelle muss man sich nicht kümmern. Diese wird automatisch erstellt falls sie nicht vorhanden ist

Zuerst zeige ich mal wie man sie anwendet

'Sequenz ganz bewusst erstellen
debug.print Sequence("SEQ_TEST").create		'1
 
'Nächste Nummer der Sequenz SEQ_TEST ausgeben
debug.print Sequence("SEQ_TEST").nextVal()	'2
debug.print Sequence("SEQ_TEST").nextVal()	'3
debug.print Sequence("SEQ_TEST").nextVal()	'4
 
'Letzte Nummer auswählen
debug.print Sequence("SEQ_TEST").lastVal		'4
 
'Zurücksetzen
debug.print Sequence("SEQ_TEST").reset()		'1
 
'löschen
call Sequence("SEQ_TEST").delete()
 
'Wieder aufrufen ohne bewusst zu erstellen. Standartmässig wird die Sequenz automatisch erstellt
debug.print Sequence("SEQ_TEST").nextVal()	'1
 
'Einen Sequenzaufruf auf eine Nicht existierende Sequenz mit Fehlergenerierung
debug.print Sequence("SEQ_TEST").nextVal(seqNotExistError)	'Error

Und ein weiteres Beispiel

Public Sub testSeq()
	Dim seqA_1 As Sequence
	Dim seqA_2 As Sequence
	Dim seqName As String: seqName = "A"
 
	'Mal vornweg die Sequenz löschen falls sie existiert
	Call Sequence(seqName).delete
 
	'seqA_1 über die staitsche Funktion erstellen
	Set seqA_1 = Sequence(seqName)
	'seqA_2 auf die klassische Art
	Set seqA_2 = New Sequence
	seqA_2.initMe (seqName)
 
	'Zugriffe über verschieden Methoden auf die Sequqenz 'A'
	'Wie man sieht, greifen alle auf dieselben Daten zu
	'Zuerst mal nextNr() auf eine Seqeunz die nicht existiert
	Debug.Print seqA_1.nextVal(seqNotExist0)             '0
	Debug.Print seqA_2.nextVal(seqNotExist0)             '0
	Debug.Print seqA_1.nextVal(seqNotExistCreate)        '1
	'Die Sequqnz ein wenig weiterblättern
	Debug.Print seqA_2.nextVal                           '2
	Debug.Print Sequence(seqName).lastVal                 '2
	Debug.Print Sequence(seqName).nextVal                 '3
	Debug.Print seqA_2.lastVal                           '3
	'un neu erstellen
	Debug.Print seqA_1.create(seqCreateOnExistReset)    '1
	Debug.Print Sequence(seqName).nextVal                 '2
 
End Sub

Um auf die Klasse zuzugreifen ohne sie vorher zu initialisieren verwende ich einen Statischen Aufruf (staticClass). Darum habe ich das folgende Modul staticClasses. Der Trick dabei ist, dass die Funktion gleich heisst wie die Klasse. Somit kann mit der Klasse wie im obigen Beispiel hantiert werden

Ein VB-Dictionary mit den bereits gebrauchten Sequenzen. Alsi Key dient der Seqenzname, als Value jeweils das Sequenzobjekt

Private staticSequence               As Dictionary

Initialisiert die Sequenzen. In der Modul-Variable staticSequenz wird pro Sequenz die aufgerufen wird eine Instanz der Klasse Sequenz erstellt. und im Speicher gehalten. @param String Name der Sequenz

Public Function Sequence(ByVal iSeqName As String) As Sequence

staticClasses.bas

Private staticSequence               As Dictionary
 
'/**
' * Initialisiert die Sequenzen
' * @param  String      Name der Sequenz
' */
Public Function Sequence(ByVal iSeqName As String) As Sequence
	Dim inst As Sequence
	If staticSequence Is Nothing Then Set staticSequence = New Dictionary
	If Not staticSequence.Exists(iSeqName) Then
		Set inst = New Sequence
		Call inst.initMe(iSeqName)
		Call staticSequence.Add(iSeqName, inst)
	End If
	Set Sequence = staticSequence.item(iSeqName)
End Function

Die Klasse handelt das ganze mit den Sequenzen. über die StaticClasses wird pro Sequenz ein

Anweisungen was bei einem create() gemacht werden soll, wenn die Sequenz bereits existiert

• 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 Sequenz um eins hoch
• seqCreateOnExistReset 'Resete die Sequenz. gibt 1 zurück
• seqCreateOnExistError 'Raise einen Error

Anweisung wie sich die entsprechende Funktion verhalten soll, wenn die Sequenz noch nicht existiert. Wird in den folgenden Methoden verwendet: lastVal, nextVal(), reset()

• seqNotExistCreate 'erstelle die Sequqnz und gib 1 zurück
• seqNotExist0 'Mach nix und gib eine 0 zurück
• seqNotExistError 'Raise einen Error

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

prüft, ob die Sequenz existiert @return Boolean

Public Property Get sequenceExists() As Boolean

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

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

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

Löscht die Sequenz

Public Sub delete()

Und die Sequenz-Klasse

sequence.cls

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "Sequence"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'-------------------------------------------------------------------------------
'File         : Sequence.cls
'               Copyright mpl by ERB software
'               All rights reserved
'Environment  : VBA 2007 +
'Version      : 1.1.0
'Name         : Sequence
'Author       : Stefan Erb (ERS)
'History      : 13.11.2013 - ERS - CreationOption Explicit
'               24.06.2014 - ERS - StandartProperty toNext hinzugefügt
'-------------------------------------------------------------------------------
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 seqCreateOptions
    seqCreateOnExistEmpty       'Mach nix und gib eine Empty 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 die StartNz 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
    seqNotExistEmpty            'Mach nix und gib eine Empty zurück
    seqNotExistError            'Raise einen Error
End Enum
 
'/**
' * Private Variablen
' */
Private seqName                 As String
Private cachefilterString       As String
Private cacheStartValue         As String
 
'/**
' * Standartausgabe als Long
' * @example    Dim nextId as Long: nextId = mySeq
' * @return Long
' */
Public Property Get toNext() As Long
Attribute toNext.VB_UserMemId = 0
    'Attribute Value.VB_UserMemId = 0
 
    toNext = nextVal
End Property
 
'/**
' * Construktuer
' * @param  String      Name der Sequenz
' */
Public Sub initialize(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 = seqNotExistEmpty) 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
 
Public Property Get startValue()
    startValue = cacheStartValue
End Property
Public Property Let startValue(ByVal iStartValue)
    cacheStartValue = iStartValue
    CurrentDb.execute "UPDATE [" & C_SEQ_TABLE & "] SET [START_NR] = " & iStartValue & " WHERE [SEQ_NAME] = '" & seqName & "'"
End Property
 
 
'/**
' * Erstellt die Sequenz
' * @param  seqCreateOptions     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 iStartValue As Long = 1, _
        Optional ByVal iOption As seqCreateOptions = seqCreateOnExistEmpty _
) As Long
    cacheStartValue = iStartValue
    If Me.sequenceExists Then
        Select Case iOption
            Case seqCreateOnExistEmpty:     create = Empty
            Case seqCreateOnExistLastVal:   create = Me.lastVal
            Case seqCreateOnExistNextVal:   create = calcVal(seqNotExistEmpty)
            Case seqCreateOnExistError:     Call Err.Raise(vbObjectError, "Sequence.create", "Sequenze [" & seqName & "] allredy exists")
            Case seqCreateOnExistReset:     create = Me.reset
        End Select
    Else
        'Tabelle über DAO öffnen, damit ich den Record für mich alleine hab
        Dim rs As DAO.Recordset: Set rs = CurrentDb.OpenRecordset(C_SEQ_TABLE)
        rs.AddNew
        rs!seq_name = seqName:  rs!last_nr = cacheStartValue: rs!last_timestamp = Now(): rs!start_nr = cacheStartValue
        rs.update: rs.Close: Set rs = Nothing
        create = cacheStartValue
    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, Optional ByVal iStartNr As Variant = Null) As Long
    nextVal = calcVal(iOption, iStartNr)
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, cacheStartValue)
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 seqNotExistEmpty:  getSeqNotExists = Empty
        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 Variant = Null)
    If Me.sequenceExists Then
        Dim rs As DAO.Recordset: Set rs = CurrentDb.OpenRecordset(C_SEQ_TABLE)
        rs.index = "IDX_SEQ_NAME"
        Call rs.Seek("=", seqName)
        calcVal = IIf(IsNull(iNr), rs!last_nr + 1, iNr)
        Call rs.Edit
        rs!last_nr = calcVal
        rs!last_timestamp = Now()
        rs.update: 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, START_NR LONG 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
 
 

Einfach noch Anwendungsideen

Pro Sequenz eine eigene eigene Funktion anlegen

Private staticSeqTestB              As Sequence
 
Public Function SEQ_TEST_B() As Sequence
	If staticSeqTestB Is Nothing Then
		Set staticSeqTestB = New Sequence
		Call staticSeqTestB.initMe("SEQ_TEST_B")
	End If
	Set SEQ_TEST_B = staticSeqTestB
End Function

Anwendungsbeispiel

debug.print SEQ_TEST_B.nextVal