Allocating sequential serial numbers 1

[wacker]

I need to be able to allocate serial numbers to a field within a table. The serial number is made up of 3 parts e.g
"CPM2" "Medic1" "00012 = CPM2Medic10001.
The 1st part will always be CPM2, the 2nd part could be one of 4 values e.g Medic1, Medic2, Medic3, Medic4 and the 3rd part will be the next number in the sequence e.g 0001, 0002 etc. The 3 parts joined together will always be unique. Examples would include CPM2Medic10001, CPM2Medic10002, CPM2Medic20001, CPM2Medic30001 etc.
The code I have written is as follows:

Function AllocateSerNumb()
'THE FOLLOWING CODE IS SUPPOSED TO CHECK FOR MATCING serial numbers
'AND IF NO MATCH ALLOCATE A NEW serial number!!

Dim strPT1, strPT2, strIniSerNum, strSerNum As String
Dim intPT3 As Integer
Dim rstSurvData As Recordset
Dim dbsCDb As Database

strPT1 = "CPM2" 'will always be this
strPT2 = Forms![frmSatSurvData]![cboSection] 'could be Medic1, Medic2, Medic3, Medic4
intPT3 = Format(1, "0000&quot 'must be in this format
strIniSerNum = strPT1 & strPT2 & intPT3 'e.g. CPM2Medic10001
Set rstSurvData = CurrentDb.OpenRecordset("tblSatSurvData", dbOpenDynaset)
Set dbsCDb = CurrentDb()

'check to see if value exists in recordset
rstSurvData.FindFirst "txtSerialNo = '" & strIniSerNum & "'"

Do Until rstSurvData.NoMatch
intPT3 = intPT3 + 1
strIniSerNum = strPT1 & strPT2 & intPT3
Loop

strSerNum = strIniSerNum
MsgBox strSerNum

rstSurvData.Close
Set dbsCDb = Nothing

End Function

Am I barking up the wrong tree! Is there an easier way of doing it etc
Thanks for any help
Glen

 

[oharab]

have a look in thread181-341170 where I give code to generate a unique ID.
The code could easily be extended to suit your particular requirements.
Give me a shout if you want help with this.

Ben ----------------------------------------
Ben O'Hara
Home: bpo@SickOfSpam.RobotParade.co.uk
Work: bo104@SickOfSpam.westyorkshire.pnn.police.uk
(in case you've not worked it out get rid of Sick Of Spam to mail me!)
Web:

http://www.RobotParade.co.uk

----------------------------------------

 

[oharab]

COuldn't resist it!
Create a new table called ID & give it 2 fields Prefix & LastID.
Use this code to create your Unique ID's

Function GetNextIDWithPrefix(prefix As String) As Variant

Dim sTable As String 'table storing ID's
Dim db As DAO.Database 'this database
Dim rst As DAO.Recordset 'recordet with
Dim intRetry As Integer 'number of retries

On Error GoTo ErrorGetNextID
sTable = "AbsenceID"
'set the table with the IDs in
Set db = CurrentDb()
'set reference to this database
Set rst = db.OpenRecordset("SELECT * FROM " & sTable & " WHERE prefix='" & prefix & "';", dbOpenDynaset) 'Open table with the counter
'open a query which looks for a record that matches 'prefix'
If rst.EOF And rst.BOF Then
'if there are no records found then this is a new prefix
rst.AddNew
'add a new record
rst!prefix = prefix
'store the prefix
rst!lastid = 1
'set the counter going
rst.Update
'save the record
rst.MoveFirst
'move to the 1st record
Else
'the prefix already exists
rst.MoveFirst
'move to the record
rst.Edit
'increase the counter
rst!lastid = rst!lastid + 1
rst.Update
'save the record
End If

GetNextIDWithPrefix = prefix & Format(rst!lastid, "0000&quot
'return the unique ID


rst.Close 'tidy everything up
Set rst = Nothing
db.Close
Set db = Nothing

ExitGetNextID:
Exit Function

ErrorGetNextID: 'If someone is editing this record trap the error
If Err = 3188 Then
intRetry = intRetry + 1
If intRetry < 100 Then
Resume 'try 100 times to get in
Else 'Time out retries
MsgBox Error$, 48, &quot;Another user editing this number&quot;
Resume ExitGetNextID
End If
Else 'Handle other errors
MsgBox Str$(Err) & &quot; &quot; & Error$, 48, &quot;Problem Generating Number&quot;
Resume ExitGetNextID
End If
End Function


Call it with GetNextIDWithPrefix(&quot;CPM2Medic1&quot to get
CPM2Medic10001
CPM2Medic10002
CPM2Medic10003
etc


There is no limit to the number of prefixes you can store so this is very flexible.

Enjoy

B ----------------------------------------
Ben O'Hara
Home: bpo@SickOfSpam.RobotParade.co.uk
Work: bo104@SickOfSpam.westyorkshire.pnn.police.uk
(in case you've not worked it out get rid of Sick Of Spam to mail me!)
Web:

http://www.RobotParade.co.uk

----------------------------------------

 

[wacker]

Thanks. I'll give it a go.

 

[wacker]

Thanks Ben, that worked brilliantly!

 

[Yogi39]

Newbie in Acces....
How would I incorporate this code ?

 

[MichaelRed]

If this is a multiuser app (and Ms. A. generally is - or can be 'coverted to' quite easily), the code can (ergo WILL) fail at some point. see faq700-184, and pay particular attention to the opendaytabase/openrecordset issue, where it is opened for EXCLKUSIVE access.

If there is ANY possability that two uers will attempt to add a record 'simultaneously', both will retrieve the same &quot;original&quot; value and thus return the same value. Although Ben's code does check for an edited record, it is possible to still yet again for two (or more) users to get the same 'original' value - thus the duplication of the 'sequential' value. Other 'issues' would also be of interest, such as typo errors in the &quot;prefix&quot; argument would create a new table and thus some issues / problems in the sequences (and possibly identification of which &quot;strand&quot; the redord should be in). To handle the multiple sequence prefixes, I would include a field in the table for each of htre sequences and &quot;seed&quot; each field (with the zero if starting from 'scratch'). Then ther is no Table created and (hopefullly) some &quot;error&quot; return would alert the user to the problem.




MichaelRed
m.red@att.net

Searching for employment in all the wrong places