自定义自动编号,带断号检测补号功能-andymark
Access软件网QQ交流学习群(群号码198465573),欢迎您的加入!
首页 >技术文章> 源码示例


自定义自动编号,带断号检测补号功能

发表时间:2008/11/6 9:17:04 评论(2) 浏览(10314)  评论 | 加入收藏 | 复制
   
摘 要:自定义自动编号,带断号检测补号功能
正 文:

点击下载此附件

适合格式: 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 TNum = Num Then
                  
                   MsgBox StrBH & "-" & Format(Now(), "" & FDay & "") & "-" & Format(Num, String(ILen, "0")) & "存在重号,请检查数据的"
                   Exit Function
                 Else
                 
                   If TNum - Num = 1 Then
                 
                      Num = TNum
                     Else
               
                      Exit Do
               
                   End If
               
                End If
              
              Rs.MoveNext
           
            Loop
        
        
         End If
     
      End If
   
  End If
ZDYBH = StrBH & "-" & Format(Now(), "" & FDay & "") & "-" & Format(Num + 1, String(ILen, "0"))
Set Rs = Nothing
Set Conn = Nothing
End Function


Access软件网交流QQ群(群号:198465573)
 
 相关文章
自定义自动编号,带断号检测补号功能  【andymark  2008/11/6】
高效的自动编号函数  【网行者  2013/1/18】
【Access示例】子窗体按主窗体字段进行自动编号的2种方法示例  【漏蛧尐魚℡  2013/1/31】
如何让access自动编号从1开始排序实现方法  【宏鹏(转载)  2013/7/10】
日期/月份为变量的自动编号(自动续号)函数  【网行者  2013/7/14】
常见问答
技术分类
相关资源
文章搜索
关于作者

andymark

文章分类

文章存档

友情链接