Access数据库培训
网站公告
·Access快速平台QQ群号:189307860    ·Access快速开发平台下载地址及教程    ·欢迎添加微信交流账号:Accessoft7    ·如何快速搜索本站文章|示例|资料!    
您的位置: 首页 > 技术文章 > Access数据库-模块/函数/VBA

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

时 间:2018-03-13 08:05:54
作 者:杨雪   ID:42182  城市:南京
摘 要:分享一段自动编号函数,当日编号不能重复,若重复,日期累加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交流群 (群号:473665531)       access源码网店

最新评论 查看更多评论(0)

发表评论您的评论将提升作者分享的动力!快来评论一下吧!

用户名:
密 码:
内 容:
 

常见问答

技术分类

相关资源

关于我们 | 服务条款 | 在线投稿 | 友情链接 | 网站统计 | 网站帮助