下面的函数能将用户输入的15位数据转化为18位。

Function IDCode15to18(sCode15 As String) As String
    '*  功能:将15的身份证号升为18位(根据GB 11643-1999)
    '*  参数:原来的号码
    '*  返回:升位后的18位号码
    Dim i As Integer
    Dim num As Integer
    Dim code As String
    num = 0
    IDCode15to18 = Left(sCode15, 6) + "19" + Right(sCode15, 9)
    '  计算校验位
    For i = 18 To 2 Step -1
      num = num + (2 ^ (i - 1) Mod 11) * (Mid(IDCode15to18, 19 - i, 1))
    Next i
    num = num Mod 11
    Select Case num
    Case 0
      code = "1"
    Case 1
      code = "0"
    Case 2
      code = "X"
    Case Else
      code = Trim(Str(12 - num))
    End Select
    IDCode15to18 = IDCode15to18 + code
End Function