Create a unique ID using dates?

E

Erik Lindquist

I would like to create a unique record ID using the date (mmddyy) and an
incremental number. Ideally I would like the ID to appear as 102305001 where
the last three digits go up by one for each record. Is there an easy way to
do this through VBA?
 
O

Ofer

Try this, function that get the date and return the new count

Function GetNewNumber(DateInFormatMMDDYY as String)
Dim MyDb as DAO.DataBase, MyRec as Recordset
Set MyDb = currentDb
Set MyRec = MyDb.OpenRecordSet("SELECT Val(Right([FieldName],3)) AS
DateCount FROM TableName WHERE Left([FieldName],6) ='" & DateInFormatMMDDYY
& "'")
If MyRec.Eof then
GetNewNumber= DateInFormatMMDDYY & "001"
Else
GetNewNumber = DateInFormatMMDDYY & format(MyRec!DateCount + 1,"000")
End If
End Function
 
A

Arvin Meyer [MVP]

Erik Lindquist said:
I would like to create a unique record ID using the date (mmddyy) and an
incremental number. Ideally I would like the ID to appear as 102305001 where
the last three digits go up by one for each record. Is there an easy way to
do this through VBA?

Here's a multi-purpose function that with a few small changes you can use to
plug in anywhere:

Function DateNum() As String
'********************************************************************
' Name: DateNum
' Purpose: Generate an incremental "number" based on the year
'
' Author: Arvin Meyer
' Date: July 27, 2003
' Comment: Assumes Table1 As Table and CaseNum As Field
' Generates in the format of 20030001, 20030002, etc.
' Seed the first number if other than 0000
'********************************************************************
On Error GoTo Error_Handler

Dim intNumber As Integer
Dim db As DAO.Database
Dim rs As DAO.Recordset

Set db = CurrentDb
Set rs = db.OpenRecordset("Select [CaseNum] from [Table1] order by
[CaseNum];")

If Not rs.EOF Then
rs.MoveLast
If Left(rs.Fields("CaseNum"), 4) = CStr(Year(Date)) Then
intNumber = Val(Mid(rs.Fields("CaseNum"), 5)) + 1
Else
intNumber = 1
End If
End If

DateNum = Year(Date) & Format(intNumber, "0000")

With rs
.AddNew
!CaseNum = DateNum
.Update
End With

Exit_Here:
rs.Close
Set rs = Nothing
Set db = Nothing
Exit Function

Error_Handler: 'If someone is editing this record trap the error
Dim intRetry As Integer
If Err = 3188 Then
intRetry = intRetry + 1
If intRetry < 100 Then
Resume
Else 'Time out retries
MsgBox Err.Number, vbOKOnly, "Another user editing this number"
Resume Exit_Here
End If
Else 'Handle other errors
MsgBox Err.Number & ": " & Err.Description, vbOKOnly, "Problem
Generating Number"
Resume Exit_Here
End If

End Function

--
Arvin Meyer, MCP, MVP
Microsoft Access
Free Access downloads:
http://www.datastrat.com
http://www.mvps.org/access
 
O

Ofer

Sorry, but you need to add max to the recordset
Set MyRec = MyDb.OpenRecordSet("SELECT Max(Val(Right([FieldName],3))) AS
DateCount FROM TableName WHERE Left([FieldName],6) ='" & DateInFormatMMDDYY
& "'")

--
If I answered your question, please mark it as an answer. That way, it will
stay saved for a longer time, so other can benifit from it.

Good luck



Ofer said:
Try this, function that get the date and return the new count

Function GetNewNumber(DateInFormatMMDDYY as String)
Dim MyDb as DAO.DataBase, MyRec as Recordset
Set MyDb = currentDb
Set MyRec = MyDb.OpenRecordSet("SELECT Val(Right([FieldName],3)) AS
DateCount FROM TableName WHERE Left([FieldName],6) ='" & DateInFormatMMDDYY
& "'")
If MyRec.Eof then
GetNewNumber= DateInFormatMMDDYY & "001"
Else
GetNewNumber = DateInFormatMMDDYY & format(MyRec!DateCount + 1,"000")
End If
End Function
--
If I answered your question, please mark it as an answer. That way, it will
stay saved for a longer time, so other can benifit from it.

Good luck



Erik Lindquist said:
I would like to create a unique record ID using the date (mmddyy) and an
incremental number. Ideally I would like the ID to appear as 102305001 where
the last three digits go up by one for each record. Is there an easy way to
do this through VBA?
 
Top