ID Generation code...not working

[NRK]

I am using the following code to try and create a unique ID based on the current month and date - in this format "FEB15_001":

Public Function GetNewID() As String
On Error GoTo Err_GetNewID

Dim lngJobID As Long, strMax As String
Dim strNewID As String, strCriteria As String
Dim dtVar As Date
Dim cnn As New ADODB.Connection
Dim rstJob As New ADODB.Recordset

Set cnn = CurrentProject.Connection
rstJob.Open "[qryMaxJobID]", cnn, adOpenDynamic

strCriteria = Left(Format(Date, "mmmdd&quot, 5)

With rstJob
.Find strCriteria
If .EOF Then
strMax = UCase(Format(Date, "mmmdd&quot) & "_000"
Else
strMax = ![MaxJobID]
'finding greatest ID, not greatest ID per date...(2/15/02)
End If
End With

lngJobID = CLng(Right(strMax, 3)) + 1

strNewID = UCase(Format(Date, "mmmdd&quot) & Format(lngJobID, "000&quot
GetNewID = strNewID

Exit_GetNewID:
rstJob.Close
Set rstJob = Nothing
cnn.Close
Set cnn = Nothing
Exit Function

Err_GetNewID:
MsgBox Err.Description, , "GetNewID: " & Err.Number
Resume Exit_GetNewID

End Function

Then, when I click to add a new record the code should automatically increment the ID number by one. So, if today I have one ID (FEB15_001) and click ADD, I should expect ID FEB15_002 to be generated. Equally, if I have no IDs entered yet (i.e. for tomorrow), then I should expect FEB16_001.

Unfortunately, my code only increments once. I have tried it for various numbers (i.e. basing it off of 1, 4, 5) to verify but it only adds 1 to the ID once and then stops.

Does anyone have any ideas?

 

[MichaelRed]

I see only the find for the FIRST record w/ the date. Since -if one doesn't exist, the default rec ("mmmdd_000&quot is added, I assume that on all subsquent executions, this is found (first) and the "000" part is (properly) incremented. You need to (essientially) do the findLAST process ...

MichaelRed
m.red@att.net

There is never time to do it right but there is always time to do it over