Ocupar Faltante en numero secuencial, según fecha, en campo texto

He modificado el ejemplo con que le respondí en días anteriores.

No incluyo la tabla ya que es la misma.

Voy a retirar los registros que aparecen marcados en rojo, es decir las solicitudes 2021072202 y 2021072205 y obtengo:

Observe que no aparecen los registros 2021072202 y 2021072205. Ahora voy a adicionar 2 registros y obtengo.

Efectivamente utilizo la numeración que había retirado. ¿Cómo lo hago?

Utilizo 2 funciones, una principal que me retorna el número que hace falta o en su defecto el siguiente. Esta es la función.

FUNCIONES

Private Sub btnRetirar_Click()
 Dim temfecha As Date
 If MsgBox("¿Está seguro que retira la solicitud " & Me.solicitud & "?", vbQuestion + vbYesNo + vbDefaultButton2, "Retiro") = vbNo Then
   Exit Sub
 End If
 temfecha = Me.fechasol
 CurrentDb.Execute "DELETE FROM tblsolicitud WHERE ID=" & Me.ID
 Me.Requery
 DoCmd.GoToRecord , , acNewRec
End Sub
Private Sub fechasol_AfterUpdate()
 If Me.NewRecord Then
   Me.solicitud = tomalibre(Me.fechasol)
 End If
End Sub
Private Sub Form_Open(Cancel As Integer)
  DoCmd.GoToRecord , , acNewRec
End Sub

Observe como en la variable anterior controlo el consecutivo, si es igual a cero (0) indica que hay un salto en la numeración, entonces me salgo del bucle y retorno la cadena con el número que hace falta. Pero si anterior nunca es cero (0), es decir la numeración está completa entonces llamo la función sgtesol().

Public Function sgtesol(mfecha As Date) As String
  Dim strSQL As String
  Dim strAux As String
  Dim db As DAO.Database
  Dim rs As DAO.Recordset
  Dim aux As Integer
  strAux = Year(mfecha) & Format(Month(mfecha), "00") & Format(Day(mfecha), "00")
strSQL = "SELECT Count(tblsolicitud.solicitud) AS CANTIDAD FROM tblsolicitud " & vbCrLf
strSQL = strSQL & " HAVING Mid([solicitud],1,8)='" & strAux & "'"
Set db = CurrentDb
Set rs = db.OpenRecordset(strSQL)
If rs.RecordCount = 0 Then
  sgtesol = strAux & "01"
Else
   sgtesol = strAux & Format(rs!CANTIDAD + 1, "00")
End If
rs.Close
db.Close
Set rs = Nothing
Set db = Nothing
End Function

CÓDIGO DEL FORMULARIO

Private Sub btnRetirar_Click()
 Dim temfecha As Date
 If MsgBox("¿Está seguro que retira la solicitud " & Me.solicitud & "?", vbQuestion + vbYesNo + vbDefaultButton2, "Retiro") = vbNo Then
   Exit Sub
 End If
 temfecha = Me.fechasol
 CurrentDb.Execute "DELETE FROM tblsolicitud WHERE ID=" & Me.ID
 Me.Requery
 DoCmd.GoToRecord , , acNewRec
End Sub
Private Sub fechasol_AfterUpdate()
 If Me.NewRecord Then
   Me.solicitud = tomalibre(Me.fechasol)
 End If
End Sub
Private Sub Form_Open(Cancel As Integer)
  DoCmd.GoToRecord , , acNewRec
End Sub

Espero con lo expuesto se recupere del "desespero". Si quiere solicite el ejemplo a [email protected] favor anotar en el asunto la consulta.

Estuve revisando y sobra la función sgtesol(), en este caso cambie la función tomalibre() por esta.

Public Function tomalibre(mfecha As Date) As String
  Dim db As DAO.Database
  Dim rs As DAO.Recordset
  Dim faux As String
  Dim cuenta As Integer
  Dim aux As String
  Dim aux2 As String
  Dim anterior As String
   faux = Format(mfecha, "\#mm\/dd\/yyyy\#")
  Set db = CurrentDb
  Set rs = db.OpenRecordset("SELECT * FROM tblsolicitud WHERE fechasol=" & faux & " ORDER BY ID")
  cuenta = 0
  Do Until rs.EOF
     aux = Year(mfecha) & Format(Month(mfecha), "00") & Format(Day(mfecha), "00") + Format(cuenta + 1, "00")
     anterior = DCount("*", "tblsolicitud", "[solicitud]='" & aux & "'")
     If anterior = 0 Then
        aux2 = aux
         Exit Do
     End If
      cuenta = cuenta + 1
    rs.MoveNext
  Loop
  If aux2 = "" Then
   tomalibre = aux + 1
  Else
    tomalibre = aux2
 End If
End Function