Los datos expuestos en este blog, son solo de índole informativo. Por favor realiza siempre una copia de seguridad antes de realizar cualquier cambio en tu proyecto.
MS Access 2003: cree números de serie que se puedan controlar usando formatos como OD00000001 y genere múltiples registros a la vez
Este tutorial de MSAccess muestra cómo usar formatos como OD00000001 para crear números de serie que puede controlar y generar varios registros a la vez en Access 2003 (con capturas de pantalla e instrucciones paso a paso).
Pregunta: En Microsoft Access 2003/XP/2000/97, quiero crear un formulario que genere varios registros a la vez. A cada registro se le debe asignar un número de secuencia que puedo controlar. Necesito el número de serie en el formato:
OD00000001
Donde
DE = tipo
00000001 = número de serie
Entonces, si especifico que el formulario debe crear 5 registros, debe completar la tabla con 5 registros cuyas claves principales son OD00000001, OD00000002, OD00000003, OD00000004 y OD00000005.
¿Es posible?
Respuesta: Hemos creado una base de datos de Access de muestra que puede descargar que demuestra cómo crear números de serie que puede controlar como se describe anteriormente.
Descargar versión en Access 2000
Veamos este ejemplo. Tenemos una tabla BoxesReceived con los siguientes campos: BoxTrack (este será el número de secuencia), JobID, Task, NoofBoxes, DateReceived, TimeReceived, DueDate, DueTime, Receivedby.
Cuando abrimos una base de datos de Access, un archivo llamado frmAddBoxesReceived se abrirá automáticamente, permitiéndonos crear múltiples registros en la tabla BoxesReceived. Este formulario funciona de la siguiente manera:
paso 1, el usuario ingresará varias casillas. Esto nos dice cuántos registros crear en la tabla BoxesReceived.
Paso 2el usuario ingresará un valor común para cada registro BoxesReceived.
Paso 3, si el usuario hace clic en el botón Crear registro, el código VBA creará la cantidad de registros en la tabla BoxesReceived según el valor ingresado en el paso 1. Al campo BoxTrack se le asignará un número de serie mayor que el de acuerdo con el formato OD00000001 especificado.
Después de que se complete el código VBA, mostrará el siguiente mensaje si todo fue exitoso.
Luego abrirá automáticamente un formulario llamado frmBoxesReceived que mostrará todos los registros en la tabla BoxesReceived, incluido el registro recién creado.
El usuario puede controlar la asignación del siguiente número a través de la tabla de códigos. En esta tabla, hay un registro “OD” que muestra el último número asignado. El usuario puede modificar este valor en consecuencia para comenzar con cualquier número adecuado.
Acerca de los eventos de clic Crear un registro botón, hay un código para garantizar que se ingrese un valor válido en frmAddBoxesReceived y llame a una función para crear un nuevo registro.
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
Luego, en el Módulo 1 de la base de datos de Access, hay una función llamada CreateBoxesReceived Crear un nuevo registro.
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
Luego, en el Módulo 1 de la base de datos de Access, hay una función llamada nuevo código de proyecto Devuelve el siguiente número en la secuencia y los incrementos Last_Nbr_Assigned El campo consta de 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
Si después de probar este ejemplo obtiene un error “indefinido” en la declaración “Dim db as Database”, debe seguir algunas instrucciones adicionales.