自动编号函数--当日编号不能重复，若重复，日期推后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