This does exactly that for a Building Work Request:
Function AssignWRBID(strTableName As String, strCounterField As String)
On Error GoTo AssignWRBID_Err
Dim dblNewID As Double
Dim strYear As String
Dim strMonth As StringDim strDay As String
Dim strNumber As String
Dim strNextSequenceNumber As String
dblNewID = GetNextCounter(strTableName)
If dblNewID <> -1 Then
strYear = Format$(DatePart("yyyy", Date), "0000")
strMonth = Format$(DatePart("m", Date), "00")
strDay = Format$(DatePart("d", Date), "00")
strNumber = Format$(dblNewID, "0000")
strNextSequenceNumber = "WRB" & strYear & strMonth & strDay & strNumber
Screen.ActiveForm(strCounterField) = strNextSequenceNumber
Else
MsgBox "Can't Add Record; Counter Not Available", MB_OK + MB_CRITICALSTOP + MB_BTN1DEFAULT, "Error Saving Record"
SendKeys "{ESC}{ESC}"
End If
AssignWRBID_Exit:
Exit Function
AssignWRBID_Err:
SendKeys "{ESC}{ESC}"
MsgBox "Error " & Err & ": " & Error$, MB_OK + MB_CRITICALSTOP + MB_BTN1DEFAULT, "AssignID"
Resume AssignWRBID_Exit
End Function
-----------
Function GetNextCounter(strTableName As String) As Double
Dim MyDB As Database
Dim MySet As Recordset
Dim CurrentCounter As Integer
Dim CurrentDate As Double
Dim TodayDate As Double
Dim intLockCount As Integer
On Error GoTo GetNextCounter_Err
intLockCount = 0
'SET THE VARIABLE TodayDate TO TODAY'S DATE.
TodayDate = Date
Debug.Print TodayDate
' OPEN A TABLE ON THE APPROPRIATE TABLE IN THE DATABASE.
Set MyDB = DBEngine.Workspaces(0).Databases(0)
Set MySet = MyDB.OpenRecordset(strTableName & "_ID", DB_OPEN_TABLE, DB_DENYREAD)
' CHECK THAT CURRENT DATE = DATE COUNTER LAST USED.
' IF YES, INCREMENT 1 AND RETURN NEXT COUNTER VA
