DMax番号シーケンス修正ギャップ

Question

私はこの機能を使って、数字8000から始まる数字と毎日8000に戻る数字を自動的に配列しようとします。また、この関数はギャップがないことを保証しようとします。したがって、手動入力があり、数字がギャップを作成する場合、フィールドは手動入力からシーケンスされません。しかし、私は前のエントリから同じ番号にとどまるだけで、コードが機能するようには見えず、増加しません。

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 

Answer 1

ループから関数を終了すると、行をバイパスしてレコードセットオブジェクトが閉じられ、クリアされます。それは問題を引き起こしていませんが、レコードセットが開かれるたびに使用されないと、なぜそれらを持っていますか？

以下、改版の手順では、私はVBAイミディエイトウィンドウから関数を呼び出すときに適切なシーケンスを返すために私のために働いた：

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