|
在ADP的窗体中实现自动流水号,如20080605-001,20080605-002
要先建一张单号表,create table t_dh(rq datetime,fhlsh int)
rq记录日期,fhlsh是流水号的最大值
必需在窗体的插入前和更新前写程序.
我这个是改进后的,那多人操作时,如流水号到了20080605-007,这时
t_dh表中的 fhlsh 的值为7如果两个天在同时录入,就会出现两个人的流水号为
20080605-008这是不行的其中一个要为20080605-009我就是对这个进行了改进
(请大家多多指教)
t_fhd的表结构为 create table t_fhd (id int,lsh varchar(50))
这是插入前的
Private Sub Form_BeforeInsert(Cancel As Integer)
On Error GoTo Err_Form_BeforeInsert
Dim rst1 As New ADODB.Recordset
Dim d As Variant
d = DLookup("fhlsh", "t_dh", "rq ='" & Format(Date, "yyyy-mm-dd") & "'")
If IsNull(d) Then '若找不到
rst1.Open "select * from t_dh", CurrentProject.Connection, adOpenDynamic, adLockOptimistic
rst1.AddNew
rst1("rq") = Format(Date, "yyyy-mm-dd")
rst1("fhlsh") = 0
rst1.Update
rst1.Close
Set rst1 = Nothing
d = 0
End If
Me![lsh] = Format(Date, "yymmdd") & "-" & Format(Nz(d, 0) + 1, "000") '加1后显示
Exit_Form_BeforeInsert:
Exit Sub
Err_Form_BeforeInsert:
MsgBox Err.Description
Resume Exit_Form_BeforeInsert
End Sub
更新前的
Private Sub Form_BeforeUpdate(Cancel As Integer)
On Error GoTo Err_Form_BeforeUpdate
Dim d As Variant
Dim x As Variant
Dim rst1 As New ADODB.Recordset
Dim d2 As Variant
Dim strLsh As String
If Me.NewRecord = True Then '若为新记录
rst1.Open "select * from t_dh where rq ='" & Format(Date, "yyyy-mm-dd") & "'", CurrentProject.Connection, adOpenDynamic, adLockOptimistic
'判断一下这个流水号是在发货记录(t_fhd)中是否有了
d = 0
Do Until IsNull(d) = True 'd为空时才退出循环,说明流水号无重复
d = DLookup("lsh", "t_fhd", "lsh='" & Me.lsh & "'")
If Not IsNull(d) Then
strLsh = Me.lsh
Me.lsh = Format(Date, "yyyymmdd") & "-" & Format(CInt(Right(Me![lsh], 3)) + 1, "000")
MsgBox strLsh & "已存在,改为" & Me.lsh
End If
Loop
x = Right(Me![lsh], 3)
rst1("fhlsh") = CInt(x) '回存目前使用编号
rst1.Update
rst1.Close
Set rst1 = Nothing
End If
Exit_Form_BeforeUpdate:
Exit Sub
Err_Form_BeforeUpdate:
MsgBox Err.Description
Resume Exit_Form_BeforeUpdate
End Sub |
|