2017-08-03 6 views
2

Ich habe diese Funktion zu, wo er versucht, an der Nummer eine Nummer zu Auto-Sequenz 8000 beginnen und die Anzahl Samen jeden Tag bis 8000 zurück. Die Funktion versucht auch sicherzustellen, dass keine Lücke vorhanden ist. Wenn es eine manuelle Eingabe gibt und die Nummer eine Lücke erzeugt, wird das Feld nicht von der manuellen Eingabe ablaufen. Aber ich kann nicht scheinen, um den Code zu arbeiten, wie es nur an der gleichen Nummer aus dem vorherigen Eintrag bleibt und nicht erhöht.DMax Zahlenfolge Fix Gap

Public Function fRetNextInSequence() As Long 
Dim MyDB As DAO.Database 
Dim rst As DAO.Recordset 
Dim rstClone As DAO.Recordset 

'If there are no Records in tblData, then have the Function return 8000 
If DCount("strSerialNumber", "tblOrderData", "dtmDateOrdered=#" & Date & "#") = 0 Then 
    fRetNextInSequence = 8000 
    Exit Function 
End If 

Set MyDB = CurrentDb 
Set rst = MyDB.OpenRecordset("tblOrderData", dbOpenSnapshot) 
Set rstClone = rst.Clone 

rst.MoveLast  'Move to Last Record [MyNum] 
With rstClone  'Move to Next-to-Last Record [MyNum] 
    .MoveLast 
    .Move -1   'Clone now at Next-to-Last Record [MyNum] 
End With 

With rst 
    Do While Not rstClone.BOF 
    If Abs(![strSerialNumber] - rstClone![strSerialNumber]) > 1 Then 
     fRetNextInSequence = (rstClone![strSerialNumber] + 1)  'Found the Gap! 
     Exit Function 
    End If 
     .MovePrevious    'Move in sync, 1 Record apart 
     rstClone.MovePrevious 
    Loop 
End With 

rst.MoveLast 

fRetNextInSequence = (rst![strSerialNumber] + 1)  'No Gap found, return next number in sequence! 

rstClone.Close 
rst.Close 
Set rstClone = Nothing 
Set rst = Nothing 
End Function  

    If SOS = "ES-S" Then 
     SerialNbrValue = fRetNextInSequence 
     'SerialNbrValue = Val(Nz(DMax("strSerialNumber", "tblOrderData", "dtmDateOrdered=#" & Date & "#"), 7999)) + 1 
    Else 
     SerialNbrValue = "" 
    End If 
+0

Warum Sie Code außerhalb eines Verfahrens zeigen, tun? Das 'If SOS ...' sollte Kompilierungsfehler verursachen. – June7

Antwort

0

Das Beenden der Funktion aus der Schleife umgeht die Zeilen, um die Re-Cord-Set-Objekte zu schließen, und zu löschen. Das verursacht das Problem nicht, aber warum haben sie es, wenn sie nicht jedes Mal verwendet werden, wenn die Recordsets geöffnet werden?

folgende überarbeitete Verfahren funktionierte für mich geeignete Folge zurück, wenn ich die Funktion aus der VBA-Direktfenster aufrufen:

Public Function fRetNextInSequence() As Long 
Dim MyDB As DAO.Database 
Dim rst As DAO.Recordset 
Dim rstClone As DAO.Recordset 

If Nz(DMin("strSerialNumber", "tblOrderData", "dtmDateOrdered=Date()"), 0) <> 8000 Then 
    'If there are no Records or the gap is 8000 for current date, Function returns 8000 
    fRetNextInSequence = 8000 
Else 
    Set MyDB = CurrentDb 
    Set rst = MyDB.OpenRecordset("SELECT strSerialNumber FROM tblOrderData WHERE dtmDateOrdered=Date() ORDER BY strSerialNumber", dbOpenSnapshot) 
    Set rstClone = rst.Clone 

    rst.MoveLast  'Move to Last Record [MyNum] 
    With rstClone  'Move to Next-to-Last Record [MyNum] 
     .MoveLast 
     .Move -1   'Clone now at Next-to-Last Record [MyNum] 
    End With 

    With rst 
    Do While Not rstClone.BOF 
     If Abs(![strSerialNumber] - rstClone![strSerialNumber]) > 1 Then 
      'Found the Gap! 
      fRetNextInSequence = (rstClone![strSerialNumber] + 1) 
      Exit Do 
     End If 
     .MovePrevious    'Move in sync, 1 Record apart 
     rstClone.MovePrevious 
    Loop 
    End With 

    If fRetNextInSequence = 0 Then 
     'No Gap found, return next number in sequence! 
     rst.MoveLast 
     fRetNextInSequence = (rst![strSerialNumber] + 1)  
    End If 
    rstClone.Close 
    rst.Close 
    Set rstClone = Nothing 
    Set rst = Nothing 
End If 
End Function