Código: Seleccionar todo

Public Function IsDate_T(ByRef Expresion As String) As Boolean
On Error GoTo err
Dim A           As Integer
Dim B           As Integer
Dim C           As Integer
Dim P1          As Integer
Dim P2          As Integer
Dim F           As Boolean
Dim F2          As Boolean
 
            P1 = InStr(1, Expresion, "/")
            If (Not CBool(P1)) Then Exit Function
            P2 = InStr(P1 + 1, Expresion, "/")
            If (Not CBool(P2)) Then Exit Function
 
            A = Mid(Expresion, 1, P1 - 1)
            B = Mid(Expresion, P1 + 1, P2 - P1 - 1)
            C = Mid(Expresion, P2 + 1, Len(Expresion))
 
            If (A And &H20) Then Exit Function
            If (C And &H8000) Then Exit Function
 
            If (B And &H8) Then
                P1 = (B - &H8)
                If (P1 And &H4) Then
                    P1 = (P1 - &H4)
                    If (P1 And &H1) Then
                        Exit Function
                    Else
                        F2 = True
                    End If
                Else
                    If (P1 And &H2) Then
                        P1 = (P1 - &H2)
                        If (P1 Or &H0) = &H0 Then F2 = True
                    Else
                        If (P1 Or &H0) = &H0 Then F2 = True
                    End If
                End If
            Else
                If (B And &H4) Then
                    P1 = (B - &H4)
                    If (P1 And &H2) Then
                        P1 = (P1 - &H2)
                        If (P1 And &H1) Then F2 = True
                    Else
                        If (P1 And &H1) Then F2 = True
                    End If
                Else
                    If (B And &H2) Then
                        P1 = (B - &H2)
                        If (P1 And &H1) Then F2 = True
                    Else
                        If (B And &H1) Then F2 = True
                    End If
                End If
            End If
 
            If (C And &H2000) Then
                P1 = (P1 - &H2000)
                If (P1 And &H400) Then
                    P1 = (P1 - &H400)
                    If (P1 And &H200) Then
                        P1 = (P1 - &H200)
                        If (P1 And &H100) Then
                            P1 = (P1 - &H100)
                            If (P1 And &H10) Then Exit Function
                        End If
                    End If
                End If
            End If
 
            F = (((Not CBool((C Mod &H4))) And CBool(C Mod &H64)) Or (Not CBool(C Mod &H190)))
 
            IsDate_T = True
 
            If (A And &H10) Then
                P1 = (A - &H10)
                If (P1 And &H10) Then
                    If ((Not F2) And (Not F)) Then IsDate_T = False
                Else
                    If (P1 And &H8) Then
                        P1 = (P1 - &H8)
                        If (P1 And &H4) Then
                            P1 = (P1 - &H4)
                            If P1 Then
                                If (B = &H2) Then
                                    If (Not F) Then
                                        IsDate_T = False
                                    Else
                                        If (Not (P1 = &H1)) Then IsDate_T = False
                                    End If
                                Else
                                    If (P1 And &H2) Then
                                        P1 = (P1 - &H2)
                                        If (P1 And &H1) Then
                                            IsDate_T = F2
                                        Else
                                            If (P1 Or &H0) = &H0 Then
                                                IsDate_T = F2
                                            Else
 
                                                IsDate_T = Not F2
                                            End If
                                        End If
                                    End If
                                End If
                            End If
                        End If
                    End If
                End If
            End If
err:
End Function