最简单的《高效无重复自动编码解决方案》-litao专栏

通过取表中编号字段的最大数，再累加1 得到新的编号。

注：避免编号重复的问题，简单方法：是将编号字段设置为【主键】或【唯一性索引】。

如果编号重复会导致错误，来避免。这需要，新增记录后检查是否成功。

当然，如果是单用户，不存在这个问题。

比如: 编号=ABC201409140001 ...... ABC201409149999

编号头=ABC20140914

’下面示例的编号是字符串格式

Function 新编号(表名, 字段名, 编号头) As String
    Dim L As Long, 编号 As String, 流水号 As Long
    L = Len(编号头)
    编号 = Nz(DMax(字段名, 表名, "Left(" & 字段名 & ", L) = '" & 编号头 & "'"))
    If 编号 = "" Then
        流水号 = 1 '初始编号1
    Else
        流水号 = Mid(编号, L + 1) + 1 '现有流水号加1
    End If
    新编号 = 编号头 & Format(流水号, "0000")'按格式新建编号（4位流水号）
End Function

'---有网友需要避免【断号】问题。我写了个函数，试试吧！我未测试

Function 删除并收拢编号(表名, 字段名, 编号头, 删除编号) As Boolean
    Dim SQLstr As String
    Dim L As Long
    L = Len(编号头)
    '--删除编号
    SQLstr = "Delete " & 表名 & " Where [" & 字段名 & "]='" & 删除编号 & "'"
    DoCmd.RunSQL SQLstr

    '--收拢编号
    SQLstr = "Update " & 表名 & " SET [" & 字段名 & "]='" & 编号头 & "'+ CStr(CLng( MID([" & 字段名 & "]," & L + 1 & "))-1) "
    '【 MID([" & 字段名 & "]," & L + 1 & ")】=取字段流水号；
    '【CLng( MID([" & 字段名 & "]," & L + 1 & "))-1】=流水号转换为数字，再减1。
    SQLstr = SQLstr & " Where Left(" & 字段名 & ", L) = '" & 编号头 & "'AND [" & 字段名 & "]>'" & 删除编号 & "'"    '条件语句
    Debug.Print SQLstr
    DoCmd.RunSQL SQLstr
    删除并收拢编号 = True
    Exit Function
err1:
End Function