数据库中自动编号达不到自己满意的编码效果,怎么办?
小小自定义函数可帮大忙
使用方法:AutoID(编码
字段名,表名)
Function AutoID(ID_Name As String, Labe_Name As String) As String
'编码规则:名称前4个字拼音首字母+自动三位数
'如:ZSNL001 中山南路****公司
On Error GoTo Err_AutoID
Dim Rst As ADODB.Recordset
Dim
Sql As String
PYZM = ""
PutTxt = Trim(InputBox("请输入新建客户的全称", "提示"))
If PutTxt <> "" Then
For I = 0 To 3
PYZM = UCase(HZPY(Right(Left(PutTxt, 4 - I), 1))) + PYZM
Next I
Set Rst = New ADODB.Recordset
Sql = "select max(Right(" & ID_Name & ", 3)) as MaxID from " & Labe_Name & " where left(" & ID_Name & ",4)='" & PYZM & "'"
Rst.Open Sql, CurrentProject.Connection, adOpenStatic
Rst.MoveFirst
If Not IsNull(Rst("maxid")) Then
If 3 - Len(CStr(CInt(Right(Rst("MaxID"), 3)) + 1)) = 0 Then AutoID = PYZM + CStr(CInt(Right(Rst("MaxID"), 3)) + 1)
If 2 - Len(CStr(CInt(Right(Rst("MaxID"), 3)) + 1)) = 0 Then AutoID = PYZM + "0" + CStr(CInt(Right(Rst("MaxID"), 3)) + 1)
If 1 - Len(CStr(CInt(Right(Rst("MaxID"), 3)) + 1)) = 0 Then AutoID = PYZM + "00" + CStr(CInt(Right(Rst("MaxID"), 3)) + 1)
Else
AutoID = PYZM + "001"
End If
End If
Exit_AutoID:
Exit Function
Err_AutoID:
MsgBox "您输入的客户信息可能有误"
GoTo Exit_AutoID
End Function
Function HZPY(hzstr As String) As String
Dim p0 As String, C As String,
str As String
Dim I As Integer, j As Integer
p0 = "吖八嚓咑妸发旮铪讥讥咔垃呣拿讴趴七呥仨他哇哇哇夕丫匝咗"
For I = 1 To Len(hzstr)
C = "z"
str = Mid(hzstr, I, 1)
If Asc(str) > 0 Then
C = str
Else
For j = 1 To 26
If Mid(p0, j, 1) > str Then
C = Chr(95 + j)
Exit For
End If
Next
End If
HZPY = HZPY + C
Next
End Function