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