取得18位的身份证号:
Function getSFZH18(IDCard)

dim i,num,j
dim sfzh18,code
dim modValue,MidValue ' 

i=0
num=0

''判断长度

if len(IDCard)<>15 and len(IDCard)<>17 and len(IDCard)<>18  then 
MsgBox "输入的身份证位数不正确,请确认!",48,"错误信息"
exit function 
end if

'如果IDCard=15位的时候

if len(IDCard)=15 then 

sfzh18=left(IDCard,6) & "19" & right(IDCard,9)

end if

if len(IDCard)=18 then 

sfzh18=left(IDCard,17) 

end if

if len(IDCard)=17 then 

sfzh18=IDCard 

end if ''判断出生年月是否正确

if isDate( mid(sfzh18,7,4) & "-" & mid(sfzh18,11,2) & "-" & mid(sfzh18,13,2) )=False  then 

MsgBox "输入非法的日期!",48,"错误信息!"
exit function 

end if

for  i=1 to 17

if IsNumeric(mid(sfzh18,i,1))=false then 
MsgBox "录入有非数字的字符",48,"错误信息"
exit function 
end if
Next


for j=18 to 2 step -1 
modValue=2^(j-1) mod 11 
midValue=cint(mid(sfzh18,19-j,1))
num=num+modValue*midValue
Next

num=num mod 11

select case num 
case 0
code="1"
case 1
code="0"
case 2
code="X"
case 3
code="9"
case 4
code="8"
case 5
code="7"
case 6
code="6"
case 7
code="5"
case 8
code="4"
case 9
code="3"
case 10
code="2"
end select 

sfzh18=sfzh18 & code

getSFZH18=sfzh18

End function