Ciao Bella:
Bear in mind that looking up the maximum number for the current author and
adding 1 is liable to conflicts in a networked multi-user environment. You
might have seen my post in another thread recently regarding code for
avoiding this by getting the number form an external database opened
exclusively in code. Here's some similar code for doing this where subsets
of the rows are numbered independently. In this case its for male and
female, but the principle is exactly the same and the code would require very
little modification to suit your scenario. Note that the code uses DAO so be
sure you have arefernce to the DAO object library (Tools|References on the
VBA menu bar)
Public Function GetNextNumberForSex(strCounterDb As String, strSex As
String) As Long
' Accepts: Full path to database containing tblCounter table with
' long integer column NextNumber and text column Sex.
' Sex ('M' or 'F') for which next serial number to be obtained
' Returns next number in sequence for specified sex
' if external database can be opened and number obtained.
' Returns zero if unable to get next number.
Const NOCURRENTRECORD As Integer = 3021
Dim dbs As DAO.Database, rst As DAO.Recordset
Dim n As Integer, I As Integer, intInterval As Integer
Dim strSQL As String
strSQL = "SELECT * FROM tblCounter WHERE Sex = '" & strSex & "'"
' make 10 attempts to open external database exclusively
DoCmd.Hourglass True
SysCmd acSysCmdSetStatus, "Attempting to get new number"
On Error Resume Next
For n = 1 To 10
Err.Clear
Set dbs = OpenDatabase(strCounterDb, True)
If Err = 0 Then
Exit For
Else
intInterval = Int(Rnd(Time()) * 100)
For I = 1 To intInterval
DoEvents
Next I
End If
Next n
SysCmd acSysCmdClearStatus
DoCmd.Hourglass False
If Err <> 0 Then
GetNextNumberForSex = 0
Exit Function
End If
Err.Clear
Set rst = dbs.OpenRecordset(strSQL)
With rst
.Edit
' insert new row if no existing record for this sex
If Err = NOCURRENTRECORD Then
.AddNew
!Sex = strSex
!NextNumber = 1
.Update
GetNextNumberForSex = 1
Else
' update row and get next number in sequence
!NextNumber = !NextNumber + 1
.Update
GetNextNumberForSex = rst!NextNumber
End If
End With
rst.Close
dbs.Close
Set rst = Nothing
Set dbs = Nothing
End Function
