Хочу поднять эту замечательную тему.....
Прочитал ее с удовольствием (или нет..) но у из-за того что у меня также возникла надобность в генерации собственного счетчика. (от Акссесса отказаться низзя)
Я взял за основу гетца и дополнил пример так что в одной табице содержатся последние значения счетчиков для любой таблицы.

Выношу на суд кому интересно


********************************
Option Compare Database
Option Explicit

' Database storing autonumber values
Const adhcAutoNumDb = "Ch02Auto.Mdb"
' Number of lock retry attempts
Const adhcLockRetries = 5
' Lower bound of range of retry wait
Const adhcLockLBound = 2
' Upper bound of range of retry wait
Const adhcLockUBound = 10

'Error constants
Const adhcErrRI = 3000
Const adhcLockErrCantUpdate2 = 3260
Const adhcLockErrTableInUse = 3262


Sub DbCreate()
Dim i As Long
For i = 1 To 10
CurrentDb.Execute ("CREATE Table Table" & i & " (id int UNIQUE not null, str char(50))")
Next i
End Sub

Sub DbDelete()
Dim i As Long
On Error Resume Next
For i = 1 To 10
CurrentDb.Execute ("DROP Table Table" & i)
Next i
End Sub

Sub StartTest()
Dim i As Long
Dim st As Date
Dim a As Long
Dim TNum As Long
st = Now
a = 100000#

For i = 1 To a
TNum = Int(10 * Rnd) + 1
CurrentDb.Execute ("INSERT INTO Table" & TNum & " (id,str) values (" & adhGetNextAutoNumber("Òàáëèöà" & CStr(TNum)) & ",'fdhfhgf')")
Next i
MsgBox a / DateDiff("s", st, Now) & " êëþ÷åé / ñåê"
End Sub
Function adhGetNextAutoNumber(ByVal strTableName As String) As Long

On Error GoTo adhGetNextAutoNumber_Err

Dim wrk As DAO.Workspace
Dim db As DAO.Database
Dim rstAutoNum As DAO.Recordset
Dim rst As Recordset
Dim lngW As Long
Dim lngX As Long
Dim intRetryCount As Integer

Randomize
DoCmd.Hourglass True
intRetryCount = 0

'Set wrk = DAO.DBEngine.Workspaces(0)
'Set db = wrk.OpenDatabase(adhCurrentDBPath() & adhcAutoNumDb, False)
Set db = CurrentDb
Set rst = db.OpenRecordset("SysTCount", dbOpenTable, dbDenyRead)
Set rstAutoNum = rst.OpenRecordset

rstAutoNum.FindFirst ("TableName='" & strTableName & "'")
If rstAutoNum.NoMatch Then ' Ñ÷åò÷èê â òàáëèöå íå çàðåãåñòðèðîâàí
rstAutoNum.AddNew
rstAutoNum!TableName = strTableName
rstAutoNum!Last_ID = 0
rstAutoNum.Update
rstAutoNum.FindFirst ("TableName='" & strTableName & "'")
End If

rstAutoNum.Edit
rstAutoNum!Last_ID = rstAutoNum!Last_ID + 1
rstAutoNum.Update

adhGetNextAutoNumber = rstAutoNum!Last_ID ' lngNextAutoNum

adhGetNextAutoNumber_Exit:
DoCmd.Hourglass False
On Error Resume Next
rstAutoNum.Close
Set rstAutoNum = Nothing
db.Close
Set db = Nothing
wrk.Close
Set wrk = Nothing
Exit Function

adhGetNextAutoNumber_Err:
Select Case Err.Number
Case adhcErrRI, adhcLockErrCantUpdate2, adhcLockErrTableInUse
intRetryCount = intRetryCount + 1
If intRetryCount > adhcLockRetries Then
adhGetNextAutoNumber = -1
Resume adhGetNextAutoNumber_Exit
Else
DAO.DBEngine.Idle
lngW = intRetryCount ^ 2 * _
Int((adhcLockUBound - adhcLockLBound + 1) * Rnd() + adhcLockLBound)
For lngW = 1 To lngW
DoEvents
Next lngW
Resume
End If
Case Else
MsgBox "Error " & Err.Number & ": " & Err.Description, _
vbOKOnly + vbCritical, "adhGetNextAutoNumber"
adhGetNextAutoNumber = -1
Resume adhGetNextAutoNumber_Exit
End Select

End Function


*********************************************
Значит запустил на пробу см верзхгние процедуру тест
+
параллельно сдлелав копию БД - клиента
(Set db = DBEngine.OpenDatabase("C:\....\db1.mdb"))

на 100 тыс записей по 10 разным таблицам все прошло на ура !!!!!
просто на отлично. в поле str я вписывал какая бд внесла запись. Просмотрев результаты - ни одного выпадения, ни одного сообщения об ошибке.

Большое спасибо всем кто приводил свои рассуждения и большое спасибо Гетцу. Обязательно куплю его двух томник ;-)))