MS Access 2003: cree números de serie que se puedan controlar usando formatos como OD00000001 y genere múltiples registros a la vez

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.