自动编号函数--当日编号不能重复,若重复,日期推后1天-杨雪
Access软件网QQ交流学习群(群号码198465573),欢迎您的加入!
首页 >技术文章> Access数据库-模块/函数/VBA


自动编号函数--当日编号不能重复,若重复,日期推后1天

发表时间:2018/3/13 8:05:54 评论(0) 浏览(1029)  评论 | 加入收藏 | 复制
   
摘 要:分享一段自动编号函数,当日编号不能重复,若重复,日期累加1(日期推后一天)
正 文:
'调用示例:        =AutoNumStr("tbl_合成组","批号","产品编号","组长编号","P","yymmdd-") 返回 P170816-目录表里的编号 固定5位   P170816-CQ380738
'===============================================================================================


Public Function AutoNumStr(TableName As String, _
                           FieldName As String, _
                           ProductNumber As String, _
                           GroupNumber As String, _
                           ProductDate As Date, _
                           Optional Prefixal As String, _
                           Optional DateFormat As String)
    On Error GoTo ErrorHandler
    Dim strPrefixal As String
    Dim strTemp  As String
    Dim lngI       As Integer

    '循环
    For lngI = 0 To 365
        '按日期合成编码
        strPrefixal = Prefixal & Format(DateAdd("d", lngI, ProductDate), DateFormat) & GroupNumber & ProductNumber
        '检查是否存在重复批号,存在重复,日期继续累加1检查
        If Nz(DLookup(FieldName, TableName, "[" & FieldName & "] = '" & strPrefixal & "'"), "") = "" Then
            AutoNumStr = strPrefixal
            Exit For
        End If
    Next

Done:
    Exit Function

ErrorHandler:
    MsgBox "错误编号:  #" & Err & vbCrLf & _
           "错误来源:  " & Err.Source & vbCrLf & _
           "错误信息:  " & Err.Description, vbCritical, "出错"
    Resume Done
End Function

Access软件网交流QQ群(群号:198465573)
 
 相关文章
日期/月份为变量的自动编号(自动续号)函数  【网行者  2013/7/14】
主窗体自动编号更新,子窗体对应编号从1开始递增  【牙周炎  2014/7/8】
【Access示例】多类别自动编号示例  【易勋  2014/10/22】
快速开发平台--自动编号关联日期字段/自动编号根据日期字段动态编号  【宏鹏  2016/11/3】
如何实现access自带的自动编号从1开始重新编号  【MDZZ  2017/10/23】
重置SQL Server表中的自动编号ID为1  【缪炜  2018/1/19】
 
 访客评论
总记录:0篇  页次:0/0 9 1 :
 
 发表评论
评论内容 (必填)

常见问答
技术分类
相关资源
文章搜索
关于作者

杨雪

文章分类

文章存档

友情链接