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