Function GetNewIDCard(byval old)
‘--输入参数--
‘old in int, --生成的2位数年龄，不传值默认19岁
‘--输出参数--
‘GetNewIDCard -- 18位的随机身份证，生日为当前年月日-old年，后面4位随机
‘---------------------------------------------------------------
‘-- 模块名称： GetNewIDCard
‘-- 描 述： 生成18位的随机身份证，生日为当前年月日-old年，后面4位随机
‘---------------------------------------------------------------
‘-- 修改作者：
‘-- 修改日期：
‘-- 修改内容：
‘-----------------------------------------------------------------

‘--输入参数判断，如果为空，默认设置为18
If old = "" Then
old = 19
End If

Dim i, S ,Wi,Wf,result
Dim IDCard17
Dim today

‘--基于当前日期，生成指定的出生年月日yymmdd
today = date
yymmdd = (year(today)-old)&Right("0"&month(today),2)&Right("0"&day(today),2)

‘--生成3位数的随机数
serRnd = int(900*Rnd +100)

‘--组合成17身份证号码
IDCard17="230202"&yymmdd&serRnd

‘--生成身份证校验码
Wi= split("7,9,10,5,8,4,2,1,6,3,7,9,10,5,8,4,2",",",-1,1)
Wf= Split("1,0,X,9,8,7,6,5,4,3,2", ",",-1,1)

S=0
For i = 0 To ubound(wi)

S = cint(Wi(i)) *cint(Mid(IDCard17, i + 1, 1)) +S

Next
‘--组合成18位身份证
GetNewIDCard = IDCard17& Wf(cint((S Mod 11)))

End Function