HOLA!!!
Private Function IsDate_7913_v2(str As String) As Boolean
On Error GoTo Fin
Dim Partes(2) As Long
Dim Primer() As String
Primer = Split(str, "/")
If UBound(Primer) <> 2 Then GoTo Fin
Partes(0) = Primer(0): Partes(1) = Primer(1): Partes(2) = Primer(2)
If Partes(2) > 9999 Then GoTo Fin
Select Case Partes(1) 'verificamos el mes
Case 0
GoTo Fin
Case 1, 3, 5, 7, 8, 10, 12 'si es de 31 dias
Select Case Partes(0) 'verificamos el dia
Case Is > 31
GoTo Fin 'si es mayor que 31 es false
Case Is < 1
GoTo Fin 'si es menor que 1 es false
Case Else
IsDate_7913_v2 = True : GoTo Fin 'sino true
End Select
Case 4, 6, 9, 11 'si es de 30 dias
Select Case Partes(0)
Case Is > 30
GoTo Fin
Case Is < 1
GoTo Fin
Case Else
IsDate_7913_v2 = True : GoTo Fin
End Select
Case 2 'si es febrero
Select Case Partes(0)
Case Is > 29 'si es mayor que 29
GoTo Fin
Case Is < 1 ' si es menor a 1
GoTo Fin
Case 29
If Partes(2) Mod 4 = 0 Then
If Partes(2) Mod 100 = 0 Then
If Partes(2) Mod 400 = 0 Then IsDate_7913_v2 = True 'si es biciesto multiplo de 100 y 400
Else
IsDate_7913_v2 = True : GoTo Fin 'si es biciesto
End If
End If
Case Else
IsDate_7913_v2 = True : GoTo Fin
End Select
End Select
Fin:
End Function
Una version mucho mejor de Raul338:
Public Function IsDate_r338(ByVal str As String) As Boolean
If str = vbNullString Then Exit Function
Dim strp As Long
strp = StrPtr(str)
If lstrlenW(strp) <> 10 Then Exit Function
Dim j As Long, k As Long, dia As Long, mes As Long, año As Long, jp As Long
jp = VarPtr(j)
For k = 0 To 18 Step 2
Call RtlMoveMemory(jp, strp + k, 1)
Select Case k / 2
Case 0
If j < 48 And j > 51 Then Exit Function
dia = (j - 48) * 10
Case 1
If j < 48 And j > 57 Then Exit Function
dia = dia + (j - 48)
If dia = 0 Or dia > 31 Then Exit Function
Case 2, 5: If j <> 47 Then Exit Function
Case 3
If j <> 48 And j <> 49 Then Exit Function
mes = (j - 48) * 10
Case 4
If j < 48 And j > 57 Then Exit Function
mes = mes + (j - 48)
If mes = 0 Or mes > 12 Then Exit Function
If Not (mes = 1 Or mes = 3 Or mes = 5 Or mes = 7 Or mes = 8 Or mes = 10 Or mes = 12) And dia = 31 Then Exit Function
If mes = 2 And dia > 29 Then Exit Function
Case 6
If j < 48 And j > 57 Then Exit Function
año = (j - 48) * 1000
Case 7
If j < 48 And j > 57 Then Exit Function
año = año + (j - 48) * 100
Case 8
If j < 48 And j > 57 Then Exit Function
año = año + (j - 48) * 10
Case 9
If j < 48 And j > 57 Then Exit Function
año = año + (j - 48)
If mes = 2 And dia = 29 Then If Not (año Mod 4 = 0 And Not (año Mod 100 = 0 And año Mod 400 <> 0)) Then Exit Function
End Select
Next
IsDate_r338 = True
End Function
GRACIAS POR LEER!!!