函数作用:身份证号码侦测

yqzx

函数作用:身份证号码侦测
下面的这段代码是我从网上下载的，怎么不能用？请大侠指出总是所在。



################################################################

Public Function xfz(sid, xb) ' As Currency
    '1、身份证不满15位，2、性别与身份证不符，3、出生月份出错(不在1-12)
    '4、出生日期出错(不在1-31范围内)，5、18位校验位出错，6、18位身份证年份出借
    On Error Resume Next
    Dim s1, s2, jym, x
    If xb = 1 Then x = 1
    If xb = "男" Then x = 1
    If xb = 2 Then x = 0
    If xb = "女" Then x = 0
    s1 = " 7 910 5 8 4 2 1 6 3 7 910 5 8 4 2"
    s2 = "10x98765432"
    If Len(sid) <> 15 And Len(sid) <> 18 Then
        xfz = "身份证位数错误"
        '测试15位身份证的信息
    ElseIf Len(sid) = 15 And Val(Mid(sid, 7, 2)) < 10 Then
        xfz = "年龄好大，请多多保重!"
    ElseIf Len(sid) = 15 And Val(Mid(sid, 9, 2)) > 12 Then
        xfz = "出生月份错误!"
    ElseIf Len(sid) = 15 And Val(Mid(sid, 11, 2)) > 31 Then
        xfz = "出生日期错误!"
    ElseIf Len(sid) = 15 And Mid(sid, 15, 1) Mod 2 <> x Then
        xfz = "性别错误!"
    ElseIf Len(sid) = 15 Then
        newid = Left(sid, 6) + "19" + Right(sid, 9)
        jym = 0
        For i = 1 To 17
            jym = jym + Val(Mid(s1, i * 2 - 1, 2)) * Val(Mid(newid, i, 1))
        Next i
        xfz = newid + Mid(s2, jym Mod 11 + 1, 1)
        '测试18位身份证的信息
    ElseIf Len(sid) = 18 And Val(Mid(sid, 7, 2)) <> 19 Then
        xfz = "出生年错误!"
    ElseIf Len(sid) = 18 And Val(Mid(sid, 9, 2)) < 10 Then
        xfz = "年龄好大，请多多保重!"
    ElseIf Len(sid) = 18 And Val(Mid(sid, 11, 2)) > 12 Then
        xfz = "出生月份错误!"
    ElseIf Len(sid) = 18 And Val(Mid(sid, 13, 2)) > 31 Then
        xfz = "出生日期错误!"
    ElseIf Len(sid) = 18 And Mid(sid, 17, 1) Mod 2 <> x Then
        xfz = "性别错误!"
    Else
        newid = Left(sid, 17)
        jym = 0
        For i = 1 To 17
            jym = jym + Val(Mid(s1, i * 2 - 1, 2)) * Val(Mid(newid, i, 1))
        Next i
        If Mid(s2, jym Mod 11 + 1, 1) <> Mid(sid, 18, 1) Then
            xfz = "识别码错，应为：" & Mid(s2, jym Mod 11 + 1, 1)
        Else
            xfz = ""
        End If
    End If
End Function

sunya_0529

我原先也写过一个，你参考一下——

1. Function s15to18(IdStr) As String '身份证号码校验
   
2. On Error Resume Next
   
3. Dim wi As Variant, ji As Variant, sum%, i%, intMsg%
   
4. wi = Array(7, 9, 10, 5, 8, 4, 2, 1, 6, 3, 7, 9, 10, 5, 8, 4, 2)
   
5. ji = Array("1", "0", "X", "9", "8", "7", "6", "5", "4", "3", "2")
   
6. sum = 0
   
7. If Len(IdStr) = 15 Then
   
8.   If Not IsNumeric(IdStr) Then
   
9.     MsgBox "15位身份证号码中有非数字字符！"
   
10.     Exit Function
    
11.   End If
    
12.   IdStr = Left(IdStr, 6) & "19" & Right(IdStr, 9)
    
13. ElseIf Len(IdStr) = 18 Then
    
14.   If Not (IsNumeric(Mid(IdStr, 1, 17)) And (IsNumeric(Right(IdStr, 1)) Or Right(IdStr, 1) = "X" Or Right(IdStr, 1) = "x")) Then
    
15.     MsgBox "18位身份证号码中有非数字字符！"
    
16.     Exit Function
    
17.   End If
    
18. Else
    
19.   MsgBox "身份证号码位数不对，请检查！"
    
20.   Exit Function
    
21. End If
    
22. If IsError(DateValue(Mid(IdStr, 7, 4) & "-" & Mid(IdStr, 11, 2) & "-" & Mid(IdStr, 13, 2))) Then
    
23.   MsgBox "身份证号码中日期信息有误！"
    
24.   Exit Function
    
25. End If
    
26. 
    
27. For i = 0 To UBound(wi)
    
28.   sum = sum + Mid(IdStr, i + 1, 1) * wi(i)
    
29. Next i
    
30. 
    
31. If Len(IdStr) = 17 Then
    
32.   s15to18 = IdStr & ji(sum Mod 11)
    
33. Else
    
34.   If ji(sum Mod 11) <> Right(IdStr, 1) Then
    
35.     intMsg = MsgBox("18位身份证号码中的校验码错误！" & vbCrLf & "您要输入的是：" & Mid(IdStr, 1, 17) & ji(sum Mod 11) & "吗？", vbYesNo)
    
36.     If intMsg = vbYes Then
    
37.       s15to18 = Mid(IdStr, 1, 17) & ji(sum Mod 11)
    
38.     Else
    
39.       Exit Function
    
40.     End If
    
41.   Else
    
42.     s15to18 = IdStr
    
43.   End If
    
44. End If
    
45. End Function

复制代码

yqzx

sunya_0529 发表于 2015-2-16 09:20
我原先也写过一个，你参考一下——

能校验出部分内容，不过还是表示感谢。