[已解决]请帮忙看下这个自动编号问题

sunny-xie

以下这段代码执行的结果是同一天（如2007-12-7）取号自动生成PO-0712001,PO-0712002,PO-0712003...的效果，但是到了2007-12-8这天，自动生成的号码又变会PO-0712001....PO-071200N，

要让他在同一个月内号码连续，（如在12月份，号码是PO-0712001,PO-071200N,但到了2008-01-01时，号码就变为PO-0801001,PO-080100N,应该如何修改，请达人指教，谢谢了！

Private Sub Form_BeforeInsert(Cancel As Integer)
On Error GoTo Err_Form_BeforeInsert
Dim conn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim strSQL As String
Dim lngID 'As Long
lngID = DLookup("AutoNum", "tbl编号", "Date=#" & Date & "#")
If IsNull(lngID) Then
    Set conn = CurrentProject.Connection
    strSQL = "SELECT * FROM tbl编号;"
    rs.Open strSQL, conn, adOpenDynamic, adLockOptimistic
        rs.AddNew
        rs("AutoNum") = 0
        rs("Date") = Date
        rs.Update
    rs.Close
    Set rs = Nothing
    Set conn = Nothing
    lngID = 0
End If
    Me.PO单号 = Format("PO-") & Format(Date, "yymm") & Format(lngID + 1, "000")
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 intVal As Integer
    intVal = MsgBox("是否保存？ 单击否将撤销本次输入。", vbYesNo + vbQuestion + vbDefaultButton1, "fan0217")
If intVal = vbYes Then
    MsgBox "保存成功！", 64, "fan0217"
    If Me.NewRecord = True Then
        Dim conn As New ADODB.Connection
        Dim rs As New ADODB.Recordset
        Dim strSQL As String
        
        Set conn = CurrentProject.Connection
        strSQL = "SELECT * FROM tbl编号 WHERE Date=#" & Date & "#;"
        rs.Open strSQL, conn, adOpenDynamic, adLockOptimistic
            rs("AutoNum") = CInt(Right(Me.PO单号, 3))
            rs.Update
        rs.Close
        Set rs = Nothing
        Set conn = Nothing
    End If
Else
    Me.Undo
End If
Exit_Form_BeforeUpdate:
    Exit Sub
Err_Form_BeforeUpdate:
    MsgBox Err.Description
    Resume Exit_Form_BeforeUpdate
End Sub

[ 本帖最后由 cuxun 于 2007-12-12 07:23 编辑 ]

sunny-xie

原来是20071207001这样效果的，
现要修改为PO-0712001..PO-071200N，PO-0801001..PO-080100N这样的效果

sunny-xie

我把库上传，请看库，

现在的问题是同一天的取号是连续的，但是隔一天后，取号又重复

Victor_Duane

是不是需要一个这样的函数
'===============================================================================
'-函数名称:         autoID
'-功能描述:         自动编号 ,
'-输入参数说明:     参数1:tblname 表名
'                   参数2:fldname 字段名
'                   参数3:intlength增长号的长度
'                   参数4:prefix 前缀(可选参数)
'                   参数5:dateformat时间前缀(可选参数)
'-返回参数说明:     可以按时间自增长编号, 如果没有时间就自增长编号
'-使用语法示例:     AutoID("型体编号表", "型体编号", 4, "GL")
'                   AutoID("型体编号表", "型体编号", 4)
'                   AutoID("型体编号表", "型体编号", 4, "GL","yyyymmdd")
'-参考:
'-使用注意:
'-兼容性:           2000,XP,2003
'-作者:             Victor Duane
'-更新日期：        2007-12-5 17:03
'===============================================================================
Function AutoID(tblName As String, fldName As String, intLength As Integer, Optional Prefix As String = "", Optional DateFormat As String = "") As String
'自动编号 , 可以按时间自增长编号, 如果没有时间就自增长编号
Dim rs As New ADODB.Recordset
Dim cn As New ADODB.Connection

Dim intDate As Integer
Dim intPrefix As Integer

Dim strDate As String
Dim strToday As String
Dim OldDate As String

'如果DateFormat为空,当天日期为空,否则为当天日期
If Len(DateFormat) = 0 Then
    strToday = ""
Else
    strToday = Format(Date, DateFormat)
End If

strDate = strToday
intDate = Len(strDate) '取得时间的长度
intPrefix = Len(Prefix) '取得前缀的长度

Set cn = CurrentProject.Connection
Dim strSQL As String
strSQL = "select * from " & tblName & " order by " & fldName
rs.Open tblName, cn, 1, 2

Debug.Print rs.RecordCount
If rs.RecordCount > 0 Then
    rs.MoveLast
    '取得最大值的时间前缀
    OldDate = Nz(Mid$(rs(fldName), intPrefix + 1, intDate), "")
    '判断新增的值是否跨时间
    If strToday = OldDate Then
        AutoID = Prefix & strDate & Format(Val(Right$(rs(fldName), intLength) + 1), String(intLength, "0"))
    Else
        AutoID = Prefix & strDate & String(intLength - 1, "0") & "1"
    End If
Else
    AutoID = Prefix & strDate & String(intLength - 1, "0") & "1"
End If

rs.Close
cn.Close
Set rs = Nothing
Set cn = Nothing
End Function

Victor_Duane

如果是要写在绑定数据窗体里
Private Sub Form_Current()
if me.newrecord then
me.id=AutoID("tbl客户", "po编号", 3, "PO-","yymm")
end if
end sub

sunny-xie

斑竹有没有调试过？
加上代码后，编号不会变动啊

烦请用我的库举个例子，谢谢了！

sunny-xie

效果实现，非常感谢斑竹！

原代码的格式其实是按PO-年月日000这样的，我以为改成这样就可以Me.PO单号 = Format("PO-") & Format(Date, "yymm") & Format(lngID + 1, "000")，结果同一天里可以，过一天，编号就重复了

Private Sub 命令1_Click()
On Error GoTo Err_命令1_Click
Dim StrDate As String
Dim TempNum As Integer

    DoCmd.GoToRecord , , acNewRec
   

StrDate = Format(Date, "yymm")


   
   TempNum = Mid(Nz(DMax("po单号", "tbl客户", "mid(po单号,4,4)='" & StrDate & "'"), "000000000"), 8)

   
   Me.PO单号 = "P0-" & StrDate & Format(TempNum + 1, "000")
   


Exit_命令1_Click:
    Exit Sub

Err_命令1_Click:
    MsgBox Err.Description
    Resume Exit_命令1_Click

End Sub