Steve R.
Retired
- Local time
- Today, 02:58
- Joined
- Jul 5, 2006
- Messages
- 4,673
The purpose of the code below is to minimize entering "bad" dates. The code only catches blatantly obvious errors. For example, entering a date before the creation of the database. Another example, entering a future date. (In certain cases, entering a future date may be perfectly acceptable, such as an appointment. In that situation, you may still wish to have an upper limit, such as allowing a date one year into the future.)
The code is designed to only display one error message at a time. That is controlled by the variable: "bolNOskipFRM".
The code also asks for verification should the date entered be over 30 days old and if the date entered occurs on a weekend.
The code does not deal with holidays.
Unimplemented (as there was no current need) in this example: "CheckDate05", the last function displayed below. The purpose of this example is to prevent one date from being earlier than another date. For example you ship a product on 1/1/2013 and it arrives on 2/1/2013. Should a person attempt to enter an arrival date earlier than 1/1/2013 they would receive an error message.
Code below is in the before update event of the control holding the date.
CheckDate Module Code Below.
The code is designed to only display one error message at a time. That is controlled by the variable: "bolNOskipFRM".
The code also asks for verification should the date entered be over 30 days old and if the date entered occurs on a weekend.
The code does not deal with holidays.
Unimplemented (as there was no current need) in this example: "CheckDate05", the last function displayed below. The purpose of this example is to prevent one date from being earlier than another date. For example you ship a product on 1/1/2013 and it arrives on 2/1/2013. Should a person attempt to enter an arrival date earlier than 1/1/2013 they would receive an error message.
Code below is in the before update event of the control holding the date.
Code:
Private Sub InspectionDate01_BeforeUpdate(Cancel As Integer)
Rem Check the Date being entered for errors - Check the Date being entered for errors
If Not IsBlank(Me.ActiveControl) Then
intResponse01FRM = 0
bolNOskipFRM = True
Rem CheckDate01 ---------------------------------- Date Before January 1, 2007 Not Allowed
intResponse01FRM = CheckDate01(Me.ActiveControl)
If intResponse01FRM > 0 Then bolNOskipFRM = False
If intResponse01FRM = 1 Then Cancel = True
Rem CheckDate02 ---------------------------------- Future Date - Not Allowed
If bolNOskipFRM Then
intResponse01FRM = CheckDate02(Me.ActiveControl)
If intResponse01FRM > 0 Then bolNOskipFRM = False
If intResponse01FRM = 1 Then Cancel = True
End If
Rem CheckDate03 ---------------------------------- Over Thirty Days Old - Ask if Correct
If bolNOskipFRM Then
intResponse01FRM = CheckDate03(Me.ActiveControl)
If intResponse01FRM > 0 Then bolNOskipFRM = False
If intResponse01FRM = 7 Then Cancel = True
End If
Rem CheckDate04 ---------------------------------- Weekend Date - Ask if Correct
If bolNOskipFRM Then
intResponse01FRM = CheckDate04(Me.ActiveControl)
If intResponse01FRM > 0 Then bolNOskipFRM = False
If intResponse01FRM = 7 Then Cancel = True
End If
End If
End SubCheckDate Module Code Below.
Code:
Option Compare Database
Option Explicit
Rem Check the Validity of Dates that have been entered.
Public Function CheckDate01(ReferenceDate As Date) As Integer
Rem Confirm that the date Entered is not before January 1, 2007
CheckDate01 = 0
If ReferenceDate < #1/1/2007# Then
MSG1 = "Please enter a date on or after January 1, 2007." & Chr(13) & "CANCEL to cancel entry."
MSGTITLE = " EARLY DATE"
CheckDate01 = MsgBox(MSG1, vbOKCancel + vbDefaultButton2, MSGTITLE)
End If
End Function
Public Function CheckDate02(ReferenceDate As Date) As Integer
Rem Confirm that the date Entered is not a future date.
CheckDate02 = 0
If DateDiff("d", ReferenceDate, Date) < 0 Then
MSG1 = "You have entered a date that has not yet arrived." & Chr(13) & "CANCEL to cancel entry."
MSGTITLE = " FUTURE DATE NOT ALLOWED"
CheckDate02 = MsgBox(MSG1, vbOKCancel + vbDefaultButton2, MSGTITLE)
End If
End Function
Public Function CheckDate03(ReferenceDate As Date) As Integer
Rem Advise when the date entered is over 30 days old.
CheckDate03 = 0
If DateDiff("d", ReferenceDate, Date) > 30 Then
MSG1 = "You have entered a date that is " & DateDiff("d", ReferenceDate, Date) & " days earlier than today." & Chr(13) & Chr(13) & "YES to accept date." & Chr(13) & "NO to enter a different date." & Chr(13) & "CANCEL to cancel entry."
MSGTITLE = " ADVISORY DATE MESSAGE"
CheckDate03 = MsgBox(MSG1, vbYesNoCancel + vbDefaultButton2, MSGTITLE)
End If
End Function
Public Function CheckDate04(ReferenceDate As Date) As Integer
Rem Advise when the date entered is a WEEKEND date.
CheckDate04 = 0
If (Weekday(ReferenceDate) = 1 Or Weekday(ReferenceDate) = 7) Then
If Weekday(ReferenceDate) = 1 Then MSG2 = "Sunday" Else MSG2 = "Saturday"
MSG1 = "You have entered a date that is a " & MSG2 & "." & Chr(13) & Chr(13) & "YES to accept date." & Chr(13) & "NO to enter a different date. " & Chr(13) & "CANCEL to cancel entry."
MSGTITLE = " WEEKEND DATE"
CheckDate04 = MsgBox(MSG1, vbYesNoCancel + vbDefaultButton2, MSGTITLE)
End If
End Function
Public Function CheckDate05(ReferenceDate01 As Date, ReferenceDate02 As Date, strMSG As String) As Integer
Rem Advise if the date (RefernceDate02) is earlier than the Reference01 date. EARLIER EARLIER
Rem Nothing can be earlier than the received date
CheckDate05 = 0
If DateDiff("d", ReferenceDate01, ReferenceDate02) < 0 Then
MSG1 = "Please enter a date that is on or after the " & strMSG & " date." & Chr(13) & "OK to enter a different date." & Chr(13) & "CANCEL to cancel."
MSGTITLE = " INCORRECT EARLY DATE"
CheckDate05 = MsgBox(MSG1, vbOKCancel + vbDefaultButton2, MSGTITLE)
End If
End Function