Access: Create a sequential number that you can control using a format such as OD00000001 and generate multiple records at once in Access 2003/XP/2000/97
Question: In Access 2003/XP/2000/97, I want to create a form that generates a number of records at once. Each record should be assigned a sequential number that I can control. I need the format of the sequential number to be:
OD00000001
where
OD = the type
00000001 = the sequential number
So if I specify that the form should create 5 records, it should populate the table with 5 records whose primary keys are OD00000001, OD00000002, OD00000003, OD00000004, and OD00000005.
Is this possible?
Answer: We've created a sample Access database that you can download that demonstrates how to create a sequential number that you can control as described above.
Download version in Access 2000
Let's take a look at the example. We have a BoxesReceived table that consists of the following fields: BoxTrack (this will be the sequential number), JobID, Task, NoofBoxes, DateReceived, TimeReceived, DueDate, DueTime, Receivedby.
When we open the Access database, a form called frmAddBoxesReceived will automatically open that allows us to create multiple records in the BoxesReceived table. This form works as follows:
Step 1, the user will enter a number of boxes. This tells us how many records to create in the BoxesReceived table.
Step 2, the user will enter the common values for each BoxesReceived record.
Step 3, if the user clicks on the "Create Records" button, the VBA code will create the number of records in the BoxesReceived table based on the value entered in Step 1. The BoxTrack field will be assigned a sequential number based on the OD00000001 format specified above.
When the VBA code has completed, it will display the following message if everything was successful.
Then it will automatically open a form called frmBoxesReceived that will display all records in the BoxesReceived table including the records just created.
The user can control the assignment of the next number through the Codes table. In this table, there is a record for "OD" that displays the last number assigned. The user can modify this value accordingly to start at whatever number is appropriate.
On the click event for the Create Records button, there is code that makes sure that valid values are entered on the frmAddBoxesReceived and calls the functions to create the new records.
Private Sub cmdCreate_Click()
Dim LResponse As Integer
'Must enter a Number of boxes
If IsNull(NoofBoxes) = True Or Len(NoofBoxes) = 0 Or IsNumeric(NoofBoxes) = False Then
LResponse = MsgBox("You must enter a valid Number of Boxes.", vbInformation, "Validation Failed")
NoofBoxes.SetFocus
'Must enter a Job
ElseIf IsNull(JobID) = True Or Len(JobID) = 0 Then
LResponse = MsgBox("You must enter a valid Job.", vbInformation, "Validation Failed")
JobID.SetFocus
'Must enter a Task
ElseIf IsNull(Task) = True Or Len(Task) = 0 Then
LResponse = MsgBox("You must enter a valid Task.", vbInformation, "Validation Failed")
Task.SetFocus
'Must enter a DateReceived
ElseIf IsNull(DateReceived) = True Or Len(DateReceived) = 0 Then
LResponse = MsgBox("You must enter a valid Date Received.", vbInformation, "Validation Failed")
DateReceived.SetFocus
'Must enter a TimeReceived
ElseIf IsNull(TimeReceived) = True Or Len(TimeReceived) = 0 Then
LResponse = MsgBox("You must enter a valid Time Received.", vbInformation, "Validation Failed")
TimeReceived.SetFocus
'Must enter a DueDate
ElseIf IsNull(DueDate) = True Or Len(DueDate) = 0 Then
LResponse = MsgBox("You must enter a valid Due Date.", vbInformation, "Validation Failed")
DueDate.SetFocus
'Must enter a DueTime
ElseIf IsNull(DueTime) = True Or Len(DueTime) = 0 Then
LResponse = MsgBox("You must enter a valid Due Time.", vbInformation, "Validation Failed")
DueTime.SetFocus
'Must enter a Receivedby
ElseIf IsNull(Receivedby) = True Or Len(Receivedby) = 0 Then
LResponse = MsgBox("You must enter a valid Received by.", vbInformation, "Validation Failed")
Receivedby.SetFocus
'Create records
Else
If CreateBoxesReceived(Form_frmAddBoxesReceived, "OD") = True Then
MsgBox "Records were successfully created."
DoCmd.OpenForm "frmBoxesReceived", acFormDS
DoCmd.Close acForm, "frmAddBoxesReceived"
Else
MsgBox "Failed."
End If
End If
End Sub
Then in Module1 in the Access database, there is a function called CreateBoxesReceived that creates the new records.
Function CreateBoxesReceived(pfrm As Object, pValue As String) as Boolean
Dim db As Database
Dim LInsert As String
Dim LBoxTrack As String
Dim LLoop As Integer
On Error GoTo Err_Execute
Set db = CurrentDb()
LLoop = 1
'Create number of records based on NoofBoxes value (Number of Boxes)
While LLoop <= pfrm.NoofBoxes
'Get next BoxTrack value (sequential number)
LBoxTrack = NewItemCode("OD")
If LBoxTrack = "" Then
GoTo Err_Execute
End If
'Create new record
LInsert = "Insert into BoxesReceived (BoxTrack, JobID, Task, NoofBoxes, DateReceived,"
LInsert = LInsert & " TimeReceived, DueDate, DueTime, ReceivedBy) VALUES ("
LInsert = LInsert & "'" & LBoxTrack & "'"
LInsert = LInsert & ", '" & pfrm.JobID & "'"
LInsert = LInsert & ", " & pfrm.Task
LInsert = LInsert & ", " & pfrm.NoofBoxes
LInsert = LInsert & ", #" & pfrm.DateReceived & "#"
LInsert = LInsert & ", #" & pfrm.TimeReceived & "#"
LInsert = LInsert & ", #" & pfrm.DueDate & "#"
LInsert = LInsert & ", #" & pfrm.DueTime & "#"
LInsert = LInsert & ", " & pfrm.Receivedby & ")"
db.Execute LInsert, dbFailOnError
LLoop = LLoop + 1
Wend
Set db = Nothing
CreateBoxesReceived = True
Exit Function
Err_Execute:
'An error occurred
CreateBoxesReceived = False
MsgBox "An error occurred while trying to add new BoxesReceived records."
End Function
Then in Module1 in the Access database, there is a function called NewItemCode that returns the next number in the sequence and increments the Last_Nbr_Assigned field by 1.
Function NewItemCode(pValue As String) As String
Dim db As Database
Dim LSQL As String
Dim LUpdate As String
Dim LInsert As String
Dim Lrs As DAO.Recordset
Dim LNewItemCode As String
On Error GoTo Err_Execute
Set db = CurrentDb()
'Retrieve last number assigned for BoxesReceived
LSQL = "Select Last_Nbr_Assigned from Codes"
LSQL = LSQL & " where Code_Desc = '" & pValue & "'"
Set Lrs = db.OpenRecordset(LSQL)
'If no records were found, create a new pValue in the Codes table
'and set initial value to 1
If Lrs.EOF = True Then
LInsert = "Insert into Codes (Code_Desc, Last_Nbr_Assigned)"
LInsert = LInsert & " values "
LInsert = LInsert & "('" & pValue & "', 1)"
db.Execute LInsert, dbFailOnError
'New Item Code is formatted as "OD00000001", for example
LNewItemCode = pValue & Format(1, "00000000")
Else
'Determine new ItemCode
'New ItemCode is formatted as "OD0000000001", for example
LNewItemCode = pValue & Format(Lrs("Last_Nbr_Assigned") + 1, "00000000")
'Increment counter in Codes table by 1
LUpdate = "Update Codes"
LUpdate = LUpdate & " set Last_Nbr_Assigned = " & Lrs("Last_Nbr_Assigned") + 1
LUpdate = LUpdate & " where Code_Desc = '" & pValue & "'"
db.Execute LUpdate, dbFailOnError
End If
Lrs.Close
Set Lrs = Nothing
Set db = Nothing
NewItemCode = LNewItemCode
Exit Function
Err_Execute:
'An error occurred, return blank string
NewItemCode = ""
MsgBox "An error occurred while trying to determine the next ItemCode to assign."
End Function
If after trying this example, you receive a "not defined" error on the "Dim db as Database" declaration, you will need to follow some additional instructions.