IsValidDate

' Validate attributes of date data
' Returns True if valid, False if invalid
'
' Example:
'  If IsValidDateField(Value:="01/30/2001",
'  '       DateType:=psDateTypes.FutureDate, IsRequired:=True)

Function IsValidDateField(Value As Variant, Optional ByVal DateType As _
    psDateTypes = AnyValidDate, Optional ByVal IsRequired As Boolean = True) As _
    Boolean

On Error GoTo ErrorHandler
    
    Dim lngDate As Long
    Dim lngToday As Long

IsValidDateField = True

If IsRequired = True Then
        If IsNull(Value) Or Value = vbNullString Then
            IsValidDateField = False
        End If
    ElseIf IsNull(Value) Or Value = "" Then
        Value = Null
        Exit Function
    End If

If IsDate(Value) Then
        lngDate = Format$(Value, "yyyymmdd")
        lngToday = Format$(Now, "yyyymmdd")

Select Case DateType
            Case psDateTypes.FutureDate
                If lngDate <= lngToday Then
                    IsValidDateField = False
                End If
            Case psDateTypes.PastDate
                If lngDate >= lngToday Then
                    IsValidDateField = False
                End If
            Case psDateTypes.TodayOrFuture
               If lngDate < lngToday Then
                    IsValidDateField = False
                End If
            Case psDateTypes.TodayOrPast
               If lngDate > lngToday Then
                    IsValidDateField = False
                End If
        End Select
    Else
        IsValidDateField = False
    End If

Exit Function
    
ErrorHandler:
    Err.Raise Err.Number, "IsValidDateField", Err.Description

End Function

Enum psDateTypes
AnyValidDate 'Allows any valid date to be entered
PastDate 'Only allows past dates (before today) to be entered
FutureDate 'Only allows future dates (after today) to be entered
TodayOrFuture 'Only allows today or future date to be entered
TodayOrPast 'Only allows today or a previous day to be entered
End Enum

' Validate attributes of date data

' Returns True if valid, False if invalid

'

' Example:

' If IsValidDateField(Value:="01/30/2001",

' ' DateType:=psDateTypes.FutureDate, IsRequired:=True)

Function IsValidDateField(Value As Variant, Optional ByVal DateType As _
psDateTypes = AnyValidDate, Optional ByVal IsRequired As Boolean = True) As _
Boolean

On Error GoTo ErrorHandler

Dim lngDate As Long
Dim lngToday As Long

IsValidDateField = True

If IsRequired = True Then
If IsNull(Value) Or Value = vbNullString Then
IsValidDateField = False
End If
ElseIf IsNull(Value) Or Value = "" Then
Value = Null
Exit Function
End If

If IsDate(Value) Then
lngDate = Format$(Value, "yyyymmdd")
lngToday = Format$(Now, "yyyymmdd")

Select Case DateType
Case psDateTypes.FutureDate
If lngDate <= lngToday Then
IsValidDateField = False
End If
Case psDateTypes.PastDate
If lngDate >= lngToday Then
IsValidDateField = False
End If
Case psDateTypes.TodayOrFuture
If lngDate < lngToday Then
IsValidDateField = False
End If
Case psDateTypes.TodayOrPast
If lngDate > lngToday Then
IsValidDateField = False
End If
End Select
Else
IsValidDateField = False
End If

Exit Function

ErrorHandler:
Err.Raise Err.Number, "IsValidDateField", Err.Description

End Function