access中[身份证号]字段有效性规则的代码实现,以及自动从[身份证号]提取出生日期和性别

Option  Compare Database
Public  sex, ymd

Private   Sub  身份证号_BeforeUpdate(Cancel  As   Integer )
     Dim  c1, I
    c1  =   LTrim ( Trim (身份证号.Text))
    I  =   Len (c1)
     Select   Case  I
         Case   15
             If   IsDate ( Mid (c1,  7 ,  2 )  &   " / "   &   Mid (c1,  9 ,  2 )  &   " / "   &   Mid (c1,  11 ,  2 ))  =   False   Then
                 MsgBox  ( " 身份证号出生日期格式错。 " )
             End   If
            sex  =   CInt ( Right (c1,  1 ))  Mod   2   ' 性别
            ymd  =   " 19 "   &   Mid (c1,  7 ,  2 )  &   Mid (c1,  9 ,  2 )  &   Mid (c1,  11 ,  2 )
         Case   18
             Dim  Code, N1  ' 18位,末位校验
             If   IsDate ( Mid (c1,  7 ,  4 )  &   " / "   &   Mid (c1,  11 ,  2 )  &   " / "   &   Mid (c1,  13 ,  2 ))  =   False   Then   MsgBox  ( " 身份证号出生日期格式错。 " )
            N1  =   0
             For  I  =   18   To   2  Step  - 1
                N1  =  N1  +  ( 2   ^  (I  -   1 )  Mod   11 )  *  ( Mid (c1, ( 19   -  I),  1 ))
             Next
                N1  =  N1  Mod   11
                 Select   Case  N1  ' Code=Switch(N1=0,"1",N1=1,"0",N1=2,"X")
                     Case   0 : Code  =   " 1 "
                     Case   1 : Code  =   " 0 "
                     Case   2 : Code  =   " X "
                     Case   Else : Code  =  ( 12   -  N1)  &   ""
                 End   Select
                 If  Code  <>   UCase ( Right (c1,  1 ))  Then
                     MsgBox  ( " 身份证号码有误。 " )
                 End   If
            sex  =   CInt ( Mid (c1,  17 ,  1 ))  Mod   2   ' 性别
            ymd  =   Mid (c1,  7 ,  4 )  &   Mid (c1,  11 ,  2 )  &   Mid (c1,  13 ,  2 )
         Case   Else
             MsgBox  ( " 身份证号位数不对,必须为15或18位。 " )
  End   Select
End Sub

Private   Sub  身份证号_LostFocus()
    出生日期.SetFocus
    出生日期.Text  =  ymd
    性别.SetFocus
     If  sex  =   1   Then
        性别.Text  =   " 男 "
     Else
        性别.Text  =   " 女 "
     End   If
End Sub