创建一个函数：  
  ‘根据身份证获取出生年月日  
  Public   Function   GetBirthday(ByVal   str   As   String)   As   Date  
          Dim   dt   As   Date  
          If   Len(str身份证号)   =   15   Then  
                  ‘注意：需要区分2000年出生的、2000年后出生的  
                  dt   =   DateSerial("19"   &   Mid(str,   7,   2),   Mid(str,   9,   2),   Mid(str,   11,   2))  
          ElseIf   Len(str身份证号)   =   18   Then  
                  dt   =   DateSerial(Mid(str,   7,   4),   Mid(str号,   11,   2),   Mid(str,   13,   2))  
          Else  
                  dt   =   CDate("1900-01-01")  
          End   If  
           
          GetBirthday   =   dt  
  End   Function