创建一个函数:
'根据身份证获取出生年月日
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