Appointments in the past

  • Thread starter Thread starter lillylazer666
  • Start date Start date
L

lillylazer666

I've come up a bit of a problem with a planner/reminder program I am
making. I am using a Month view calander as a date selection option,
and am using this to write reminders to files using the code below:

Private Sub cmdSaveEntry_Click()
Dim PlannerDate As String, PlannerEntry As String, response As
Integer

myFile = FreeFile
PlannerDate = Calender.Value
PlannerEntry = planner.Text
If planner.Text = "" Then
response = MsgBox("You must enter some Data")
If response = vbOK Then
Exit Sub
End If
Else
Open App.Path & "\PlannerText.txt" For Append Access Write As
#myFile 'opens the text file
Write #myFile, PlannerDate, PlannerEntry 'writes the data into
the text file
Close #myFile
End If
Call myReDimArrays(PlannerDate, PlannerEntry) 'call procedure
planner.Visible = False
cmdSaveEntry.Visible = False

End Sub

However, I've realised that this will not prevent someone making an
appointment on a date in the past. When it comes to date codes, I'm
awful so can anyone suggest a quick and easy way to make sure
appointments can't be made for dates that are in the past. Help would
be very welcome.
 
Private Sub cmdSaveEntry_Click()
Dim PlannerDate As String, PlannerEntry As String
Dim response As Integer

'Check for valid date. If not there or is in the past - cancel
If NZ(Calendar.Value,#1/1/1901#) < Date() Then
Beep
Msgbox "Date is in the past",,"Cancel"
Exit Sub
end If

myFile = FreeFile
PlannerDate = Calender.Value
PlannerEntry = planner.Text
If planner.Text = "" Then
response = MsgBox("You must enter some Data")
If response = vbOK Then '<<< Not needed, the response is always OK
Exit Sub
End If '<<<< Not needed
Else
Open App.Path & "\PlannerText.txt" For Append Access Write As
#myFile 'opens the text file
Write #myFile, PlannerDate, PlannerEntry 'writes the data into
the text file
Close #myFile
End If
Call myReDimArrays(PlannerDate, PlannerEntry) 'call procedure
planner.Visible = False
cmdSaveEntry.Visible = False

End Sub
 
This will show you the basic comparison you want to make:

Sub DateCheck()
Dim dtDate As Date, strMsg As String
strMsg = "Enter your date."
dtDate = InputBox(Prompt:=strMsg, _
Title:="Date Requested")
'Compare the date selected to today's date
If dtDate < Date Then
'If in past do this
MsgBox "Date cannot be in the past. You chose " & dtDate
Else
'If today or in future do this
MsgBox "Date selected is " & dtDate
End If
End Sub

Kevin C
 
Back
Top