Gary:
While simply looking up the maximum existing value of the column and adding
1 will work fine in a single user environment, in a networked multi-user
environment there is the possibility of a conflict. One means of avoiding
this is to store the last value in a separate database which is opened
exclusively to get the next number. The following is the module I use for
this. The external database is tblCounter.mdb with a single column,
NextNumber of long integer number data type. In this code the external
database is assumed to be in the same folder as the back end .mdb file
containing the tables. Note that the code uses DAO, so you'll need a
reference to the DAO object library (Tool|References on the VBA menu bar).
Some day I'll get round to writing an ADO version.
I your case, assuming the format required is I followed by four digits, you
could call the GetNextNumber function from the form's BeforeInsert event
procedure with:
Me.[Job No] = "I" & Format(GetNextNumber,"0000")
Note that this behaves like an autonumber column in that any discarded
numbers are not re-used.
''''module begins''''
Option Compare Database
Option Explicit
Dim dbsCounter As DAO.Database, rstCounter As DAO.Recordset
Public Function GetNextNumber() As Long
Const NOCURRENTRECORD As Integer = 3021
Set rstCounter = dbsCounter.OpenRecordset("tblCounter")
On Error Resume Next
With rstCounter
.Edit
' insert new row if table is empty
If Err = NOCURRENTRECORD Then
.AddNew
!NextNumber = 1
.Update
GetNextNumber = 1
Else
' update row and get next number in sequence
!NextNumber = !NextNumber + 1
.Update
GetNextNumber = rstCounter!NextNumber
End If
End With
End Function
Public Function ConnectPath() As String
Dim dbs As DAO.Database, tdf As DAO.TableDef
Dim strConnectString As String, strDbName As String, intSlashPos As
Integer
Set dbs = CurrentDb
For Each tdf In dbs.TableDefs
If tdf.Connect <> "" Then
strConnectString = tdf.Connect
End If
Next tdf
intSlashPos = 1
strDbName = strConnectString
Do While intSlashPos > 0
intSlashPos = InStr(strDbName, "\")
strDbName = Right(strDbName, Len(strDbName) - intSlashPos)
Loop
ConnectPath = Mid(strConnectString, 11, Len(strConnectString) _
- (10 + Len(strDbName)))
End Function
Public Function OpenCounterDb(strCounterDb) As Boolean
' Opens external Counter database exclusively
' Returns True if able to open external database
Dim n As Integer, I As Integer, intInterval As Integer
' 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 dbsCounter = 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
OpenCounterDb = True
End If
End Function
Public Function CloseCounterDb()
On Error Resume Next
' close recordset and external databse if open
rstCounter.Close
dbsCounter.Close
Set rstCounter = Nothing
Set dbsCounter = Nothing
End Function
''''module ends''''
