自动生成编号的问题
在窗体中有一个按钮和一个文本框，点击按钮时，在文本框中自动生成消费单据编号，这个单据编号是由每次判断consume表中的最后一条记录的后四个字符是否重复，而生成的，可是程序运行没有错误，就是不自动执行+1。我已经试过了，它执行的就是else后面的那句。请大家帮我看看！
Private Sub Command1_Click()
Dim djbh As Long
Dim StrCnn As New ADODB.Connection
Set StrCnn = New ADODB.Connection
StrCnn.Open "Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=False;Initial Catalog=card;Data Source=WYH "
Dim rs1 As New ADODB.Recordset
rs1.CursorLocation = adUseClient
rs1.Open "select * from consume order by listno1 ", StrCnn, adOpenDynamic, adLockOptimistic
If rs1.RecordCount > 0 Then
If rs1.EOF = False then
rs1.MoveLast
djbh = Val(Right(rs1.Fields( "listno1 "), 4))+1 ——〉就是这里不执行
Text1.Text = "XF " & Format(Date, "yyyymmdd ") & "- " & Format(djbh, "0000 ")
End If
Else
Text1.Text = "XF " & Format(Date, "yyyymmdd ") & "-0001 "
rs1.Close
End If
End Sub
[解决办法]
'这样试试：
rs1.Open "select max(listno1) as listno1 from consume ", StrCnn, adOpenDynamic, adLockOptimistic
If rs1.RecordCount > 0 Then
if not isnull(rs1.fields( "listno1 ")) then
djbh = clng(rs1.fields( "listno1 "))+1
Text1.Text = "XF " & Format(Date, "yyyymmdd ") & "- " & Format(djbh, "0000 ")
End If
Else
Text1.Text = "XF " & Format(Date, "yyyymmdd ") & "-0001 "
end if
rs1.Close
[解决办法]
我觉得你这样的情况最好用一张表来保存编号信息。比如这张二个字段，日期和编号，一行数据，存取当日日期和最大编号。每次程序启动时这样处理一下：
cn.execute "update 编号表 set 日期= ' "& date & " ',编号=0 where 日期 < ' "& date & " ' "
插入数据的时候，同时更新这个表的最大值，放在一个事务中处理，这样处理效率应该好
[解决办法]
'以下代码在Access2000+VB6调试通过，数据库test.mdb中表tb字段-bh
Private Sub Command1_Click()
Dim db As ADODB.Connection
Dim rs As ADODB.Recordset
Dim tempBh As String, tempYear As String, bhNum As String
Set db = New ADODB.Connection
db.CursorLocation = adUseClient
db.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0; " + "Data Source= " + App.Path + "\test.mdb "
db.Open "Data Source= " + App.Path + "\test.mdb; "
Set rs = New ADODB.Recordset
rs.Open "tb order by bh ", db, adOpenKeyset, adLockOptimistic
If rs.RecordCount = 0 Then '第一次建立编号
bhNum = "XF " & Format(Date, "YYYYMMDD ") & "-0001 "
Else
tempdate = Format(Date, "yyyymmdd ")
'MsgBox tempdate
If rs.State = adStateOpen Then rs.Close
rs.Open "select * from tb where bh like 'XF '+ ' " & tempdate & " '+ '% ' order by bh ", db, adOpenDynamic, adLockOptimistic
'MsgBox rs.RecordCount
If rs.RecordCount > 0 Then '当天有记录时
If rs.State = adStateOpen Then rs.Close
rs.Open "tb order by bh ", db, adOpenDynamic, adLockOptimistic
rs.MoveLast
tempYear = Left(rs!bh, 11) '左边11位
tempBh = Right(rs!bh, 4) + 1 '右边4位
If Len(tempBh) = 1 Then
tempBh = "000 " & tempBh
End If
If Len(tempBh) = 2 Then
tempBh = "00 " & tempBh
End If
If Len(tempBh) = 3 Then
tempBh = "0 " & tempBh
End If
MsgBox tempBh
bhNum = tempYear & tempBh
Else
bhNum = "XF " & Format(Date, "YYYYMMDD ") & "-0001 " '当天初始临时编号
End If
End If
rs.AddNew
rs!bh = bhNum
rs.Update
rs.Close
Set db = Nothing
End Sub