Binaryworld - IsValidDateField - Check whether a date is valid ... [ VB -> Date-Time ]

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