自定义自动编号，支持断号重号检测补号功能

来源: 点击数:9534 　 | 收藏 | 复制

时　间:2008-04-02 23:21:17
作　者:andymark ID：1350 城市：深圳
摘　要:自定义自动编号，支持断号重号检测补号功能
正　文:

适用格式: XXX-YYMMDD-00000

Public Function ZDYBH(StrTable As String, StrField As String, StrBH As String, Optional FDay As String = "YYMMDD", Optional ILen As Integer = 3, Optional B As Boolean = False) As String

'==================================================================

'功能: 自定义用户编号,带断号检测功能
'格式: "XXX"-"日期格式 "-"0000"
'      StrTable 为任意表名称
'      StrField 为任意字段名称
'      StrBH    编码类型 , 可自义任意格式
'      FDay     日期格式默认日期格式为:YYMMDD",其他符合FORMAT格式的如 YYYYMM,YYYY,YYYYMMDD
'      ILen     为数字格式化长度 , 默认长度为3 代表 000 格式
'      B        为是否要检测断号 ,默认为FALSE 不检测
'用法: ZDYBH("产量表", "产量ID", "LDH")
'       ZDYBH("产量表", "产量ID", Me.Combo1)
'       ZDYBH("产量表", "产量ID", Me.Combo1, "YYYY")
'       ZDYBH("产量表", "产量ID", Me.Combo1, , 4, True)

'作者: andymark
' QQ : 42503577 , ewang11@163.com
'日期: 2008-4-2

'===============================================================

Dim Rs As New ADODB.Recordset
Dim Conn As New ADODB.Connection
Dim Str As String
Dim Num As Integer
Dim TNum As Integer
Dim StrWhere As String
Dim StrOrderWhere As String
Dim StrOrderWhereDesc As String

Set Conn = CurrentProject.Connection
Str = StrBH & "-" & Format(Now(), "" & FDay & "") & "-"
StrWhere = "select " & StrField & " from " & StrTable & " where " & StrField & " like '" & Str & "%'"
StrOrderWhere = StrWhere & " order by " & StrField & ""
StrOrderWhereDesc = StrWhere & " order by " & StrField & " DESC"

Rs.Open StrOrderWhereDesc, Conn, adOpenKeyset, adLockOptimistic

If Rs.EOF Then

      Num = 0

    Else

      Num = Right(Rs.Fields("" & StrField & ""), ILen)

      If B = True Then

         If CInt(Num) <> Rs.Fields.Count Then

            Rs.Close
            Rs.Open StrOrderWhere, Conn, adOpenKeyset, adLockOptimistic

            Num = 0

            Do While Not Rs.EOF

               TNum = CInt(Right(Rs.Fields("" & StrField & ""), ILen))

               If TN

Access软件网官方交流QQ群 (群号:54525238) 　　　　　　Access源码网店