Storing a reference number using a recordset

[LDG1234]

I have a form on which the operator inputs the required information.

On clicking the 'upload record' button, code runs to open a recordset of the data table and update the information from the fields on the form.

I have 2 problems.
1.I also want this action to generate the next reference number in the database.
2.I need the format of the number to be yyyy-###,
eg 2001-001 and so on. What properties should I give this field in my table?

Thanks in advance.

Lloyd Gozzett
Process Developer

 

[JeffH]

I think this might work for, I think perhaps it is a little more complicated than you wanted though...what you need to do is create a table with the following fields

ControlNumberCurrentNumber - Text
ControlNumberMonth - Text 'Just in case you want to use MM
ControlNumberYear - Text
Create and index named ControlDate that indexes the ControlNumberYear field

Name the table zstblControlNumber (you can change the table name, just change the constant conTableName to your table name)

There are 2 functions here, the second one is only needed if the table is linked. The original proceudre did MMYY001, so I made modifications for it to be YYYY001, but have not tested. Also, modifiy the message boxes in ther error handling if you're running on Access 200x

If you need help on how to call this function, or need more clarification, please let me know

'BEGIN CODE


'***********************************************************************************
'*** Get Control Number
'***
'*** Description
'*** Gets the next control number from the table in conTableName constant and gets the current
'*** number (field ControlNumberCurrentNumber) from the table, adds 1 to it for the
'*** next number. This function attempts to lock the table and will trap the error
'*** if table is open already. If the table is linked, this function gets the path of the
'*** database that it is linked to and opens the table (this is done so can open table with
'*** dbDenyRead option set to ensure unique number).
'***
'*** Parameters
'*** N/A
'*** Returns
'*** A string that has the Next Control Number
'*** Procedures called
'*** GetDatabasePath - gets the path of the database if the table is linked
'*** Revisions
'*** Created 5/20/1999 - Jeff Hammond jthammond@onebox.com
'***********************************************************************************
Public Function GetControlNumber() As String
Dim rstControlNumber As Recordset
Dim dbCurrent As Database
Dim dbDataDatabase As Database
Dim wrkCurrent As Workspace

Dim strMonth As String
Dim strYear As String
Dim strAutoNumber As String
Dim intNextNumber As Integer 'Holding place for next number to insert
Dim tdfAutoNumberTable As TableDef 'The table that holds the data
Dim intLoopCount As Integer
Dim strDatabasePath As String 'The connection path for the table
Const conQuote = """"
Const conMaxAutoNumberSpaces As Integer = 3 'Number of digits in the AutoNumber part of control number
Const conTableName As String = "zstblControlNumber" 'The name of the table that holds the Control Number Info"


On Error GoTo ErrorHandler

'Intialize
'Get Current Month and Year
' strMonth = Format(Date, "mm&quot
' strYear = Format(Date, "yyyy&quot
strYear = Format(Date, "yy&quot
Set dbCurrent = currentdb
Set dbDataDatabase = currentdb 'Default to current database, will be set again if a linked table

'Get the connection string from the table if it's attached
For intLoopCount = 0 To dbCurrent.TableDefs.Count - 1
If dbCurrent.TableDefs(intLoopCount).Attributes And dbAttachedTable Then 'Is an attached table
If dbCurrent.TableDefs(intLoopCount).Name = conTableName Then
strDatabasePath = GetDatabasePath(dbCurrent.TableDefs(intLoopCount).Connect) 'Get path of data database
Set wrkCurrent = DBEngine.Workspaces(0)
Set dbDataDatabase = wrkCurrent.OpenDatabase(strDatabasePath)
End If
End If
Next intLoopCount

' Open table so noone else can read
Set rstControlNumber = dbDataDatabase.OpenRecordset(conTableName, dbOpenTable, dbDenyRead)

'Seek the table based on an Index ControlDate - which has the fields ControlNumberYear and ControlNumberMonth
rstControlNumber.Index = "ControlDate"
' rstControlNumber.Seek "=", strYear, strMonth
rstControlNumber.Seek "=", strYear
'Add/Create the next control number
If rstControlNumber.NoMatch Then 'No entry exists for current year/month combo
With rstControlNumber
strAutoNumber = "001" 'First number in the series
.AddNew
!ControlNumberYear = strYear
' !ControlNumberMonth = strMonth
!ControlNumberCurrentNumber = strAutoNumber
.Update
End With
Else 'Entry exists, add number to control number
'Get next number
intNextNumber = CInt(rstControlNumber!ControlNumberCurrentNumber) + 1
strAutoNumber = CStr(intNextNumber)
'Pad new autonumber with Zeros
While Len(strAutoNumber) < conMaxAutoNumberSpaces
strAutoNumber = &quot;0&quot; & strAutoNumber
Wend
'Update to new number
With rstControlNumber
.Edit
!ControlNumberCurrentNumber = strAutoNumber
.Update
End With
End If

'Set the number
' GetControlNumber = strYear & strMonth & strAutoNumber
GetControlNumber = strYear & strAutoNumber
'Tidy up
Set dbCurrent = Nothing
Set dbDataDatabase = Nothing
Set rstControlNumber = Nothing

Exit Function

ErrorHandler:
Select Case Err.Number
Case 3262, 3261, 3008, 3211
If MsgBox(&quot;Can't get a Control Number@Another user, possibly your boss, has the table &quot; & conTableName & &quot; locked@Would you like to retry this? &quot;, vbYesNo + vbQuestion, &quot;Data Error&quot = vbYes Then
Resume
Else
GetControlNumber = &quot;&quot;
Exit Function
End If
Case 3163
MsgBox &quot;The Control Number Cannot Exceed 999.@Contact your administrator.@The field ControlNumberCurrentNumber can only except 3 digits, Please adjust the field and this Function to except more than 3.&quot;, vbCritical, &quot;Critical Error...&quot;
Exit Function
Case Else
HandleError &quot;Set Control Number&quot;
End Select
End Function

'***********************************************************************************
'*** Get Database Path
'***
'*** Description
'*** Gets the database path from the tables connection string. This is the path
'*** of the old linked table that is broken
'***
'*** Parameters
'*** The connection string from a table (tdf.connect)
'***
'*** Procedures called
'*** None
'***
'*** Revsions
'*** Created 4/1/99 - Jeff Hammond jthammond@onebox.com
'***********************************************************************************

Public Function GetDatabasePath(strConnectString As String) As String
Dim intStringCounter As Integer
Dim intStartOfPath As String
intStringCounter = 1
'Find start of path
Do Until intStringCounter = 0
intStartOfPath = intStringCounter + 1
intStringCounter = InStr(intStartOfPath, strConnectString, &quot;=&quot
Loop
GetDatabasePath = Mid(strConnectString, intStartOfPath)

End Function