北京 | 上海 | 天津 | 重庆 | 广州 | 深圳 | 珠海 | 汕头 | 佛山 | 中山 | 东莞 | 南京 | 苏州 | 无锡 | 常州 | 南通 | 扬州 | 徐州 | 杭州 | 温州 | 宁波 | 台州 | 福州 | 厦门 | 泉州 | 龙岩 | 合肥 | 芜湖 | 成都 | 遂宁 | 长沙 | 株洲 | 湘潭 | 武汉 | 南昌 | 济南 | 青岛 | 烟台 | 潍坊 | 淄博 | 济宁 | 太原 | 郑州 | 石家庄 | 保定 | 唐山 | 西安 | 大连 | 沈阳 | 长春 | 昆明 | 兰州 | 哈尔滨 | 佳木斯 | 南宁 | 桂林 | 海口 | 贵阳 | 西宁 | 乌鲁木齐 | 包头 |
Public Function ZDYBH(StrTable As String, StrField As String, StrBH As String, Optional FDay As String = "YYYY", Optional ILen As Integer = 3, Optional B As Boolean = False) As String
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
上面的代码产生的编号格式是：前缀+年代+001，定位为3位，不能增加到四位数，如何修改成前缀+年代+1，不定位，可增加到无数位，请教了
