Unique Identifier - roll yer own

[clinresys]

'Check help topic "Quotation Marks in Strings"
'strings in strings are a pain in domain aggr functions

Private Function strUnique() As String

'concatenates unique integer with a default string
'to create a unique identifier
'example uses "_default" for default string
'change index arg of Left() as needed.

Dim strCnt As Integer
Dim dcnt As Integer
Dim su As String

'count how many records have "_default" as
'first 8 characters of [TextField], add 1

strCnt = DCount("[TextField]", "tblTable", "Left([TextField],8) = '_default'&quot + 1
dcnt = strCnt

'goes into loop dcnt >= 1

Do Until dcnt = 0
su = "_default" & strCnt
'now check for records with su in TextField
dcnt = DCount("[TextField]", "tblTable", "[TextField]='" & su & "'&quot
'add count of records with su in TextField to strCnt
strCnt = strCnt + dcnt
Loop

strUnique = su

End Function

 

[oharab]

For another way, set up a table with 2 fields in, Prefix (string) and AutoNumber (long)

This will store a number of ID's, perhaps for different tables.

Just call it with GetID("2003/AA/&quot and it will return
2003/AA/001
2003/AA/002
2003/AA/003
.
.
.




Function GetID(strPrefix As String) As String
Dim sTable As String
sTable = "tblAutoNumber"

Dim db As DAO.Database
Dim rst As DAO.Recordset
Dim intRetry As Integer
Dim lngNum As Long, intA As Integer, intB As Integer
Dim strANum As String
On Error GoTo ErrorGetNextID

Set db = CurrentDb()
Set rst = db.OpenRecordset("SELECT * FROM " & sTable & " WHERE prefix='" & strPrefix & "';", dbOpenDynaset) 'Open table with the counter
rst.MoveFirst
rst.Edit
NewID:
If IsNull(rst!prefix) Then
'If this is a new prefix then
rst!autonumber = 0
rst!prefix = strPrefix
End If

lngNum = rst!autonumber + 1
rst!autonumber = lngNum
'move the autonumber on.
'if another user is trying to get it, then an error is called.
'The error handler tries 100 times to get a number.
rst.Update
GetID = strPrefix & Format(lngNum, "000&quot
'format our auto number into how we want it.
rst.Close
Set rst = Nothing
db.Close
Set db = Nothing
ExitGetNextID:
Exit Function

ErrorGetNextID: 'If someone is editing this record trap the error
Select Case Err
Case 3188
intRetry = intRetry + 1
If intRetry < 100 Then
Resume
Else 'Time out retries
MsgBox Error$, 48, &quot;Another user editing this number&quot;
Resume ExitGetNextID
End If
Case 3021
rst.AddNew
Resume NewID
Case Else 'Handle other errors
MsgBox str$(Err) & &quot; &quot; & Error$, 48, &quot;Problem Generating Number&quot;
Resume ExitGetNextID
End Select
End Function


As has been pointed out, many ways to skin many cats!!

Ben ----------------------------------------------
Ben O'Hara

http://www.RobotParade.co.uk

&quot;Where are all the stupid people from...
...And how'd they get so dumb?&quot;
NoFX-The Decline
----------------------------------------------