网上有很多的工具可以实现身份证的校验,本代码可以实现身份证号码由15位升级至18位的算法,使用方法很简单:
18位身份证号=strID_Card("15位身份证号")

'*************************************************************************
'**FUNCTION                  :strID_Card
'**INPUT                          :strOldID(String) -OLDid
'**OUTPUT                     :(String) -NEWid
'**DESCRIPTION          :ID_CARD 15 --->18
'**GOBLEVAR                :
'**CREATENAME           :YONGJUN-ZOU
'**CREATEDATE           :2007-12-10 16:38:18
'**UPDATENAME           :
'**UPDATEDATE           :
'**VERSION                    :V1.0.0
'*************************************************************************
Public Function strID_Card(strOldID As String) As String
    Dim vntA As Variant 'yanzheng
    Dim vntB As Variant 'quan
    Dim i As Integer 'for loop
    Dim strTemp As String 'temp string
    Dim intSum  As Integer 'result
    vntA = Array("1", "0", "X", "9", "8", "7", "6", "5", "4", "3", "2") '//yanzheng
    vntB = Array(7, 9, 10, 5, 8, 4, 2, 1, 6, 3, 7, 9, 10, 5, 8, 4, 2, 1) '//quan
    strTemp = Mid$(strOldID, 1, 6) & "19" & Mid$(strOldID, 7) 'frist 17 bit of IDcard
    For i = 0 To Len(strTemp) - 1
        intSum = intSum + Mid$(strTemp, i + 1, 1) * vntB(i)
    Next
    intSum = intSum Mod 11
    strID_Card = strTemp & vntA(intSum)
End Function