Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations Mike Lewis on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Schedule Time/Date - Check Valid Time/Date

VB Programming Concepts

Schedule Time/Date - Check Valid Time/Date

by  wizpooter  Posted    (Edited  )
Here is what I found and pull the code piece by piece and VIOLA that EXACTLY what i am looking for:

create the following in reference to written below:
# component name set as purpose
1. monthview1 daset (set as date) get date
2. dtpicker tiset (set as time) get time
2. textbox setdate (visible=false) manupliate date
3. textbox settime (visible=false) manupliate time
4. button scset save time/date
5. textbox errdesc give you err msg


[color green]'change nothing here[/color]
Code:
Private Function ShortDate(nvalue As String)
On Error Resume Next
If nvalue = "" Then Exit Function
Dim syear, smonth, sday
syear = Right(nvalue, 4)
sday = Left(Right(nvalue, 8), 2)
smonth = Right(nvalue, Len(nvalue) - InStr(nvalue, ",") - 1)
smonth = Left(smonth, Len(smonth) - 9)
Select Case RTrim(LTrim(smonth))
Case "January"
    smonth = 1
Case "February"
    smonth = 2
Case "March"
    smonth = 3
Case "April"
    smonth = 4
Case "May"
    smonth = 5
Case "June"
    smonth = 6
Case "July"
    smonth = 7
Case "August"
    smonth = 8
Case "September"
    smonth = 9
Case "October"
    smonth = 10
Case "November"
    smonth = 11
Case "December"
    smonth = 12
End Select
ShortDate = smonth & "/" & sday & "/" & syear
End Function

[color green]'change nothing here[/color]
Code:
Private Function NoticeExpired(comDate As String, comTime As String) As Boolean
On Error Resume Next
Dim nDate As String, tDate As String, nyear As String, tyear As String
Dim ntime As String, ttime As String
nDate = Format(comDate, "MM/DD/YYYY")
tDate = Format(Date, "MM/DD/YYYY")
ntime = Format(comTime, "HH:mm")
ttime = Format(Time, "HH:mm")
nyear = Right(nDate, 4)
tyear = Right(tDate, 4)
If nDate < tDate And nyear <= tyear Then
    NoticeExpired = True
    Exit Function
End If
If nDate = tDate And nyear = tyear And ntime < ttime Then
    NoticeExpired = True
    Exit Function
End If
NoticeExpired = False
End Function

Private Sub tiset_Change()
settime.Text = Format(tiset.Value, "h:mm AM/PM")
End Sub
Private Sub daset_DateClick(ByVal DateClicked As Date)
If daset.Value < Date Then
    errdesc.Visible = True
    errdesc.Text = "Select Another Date"
    daset.SetFocus
    Exit Sub
Else
    errdesc.Visible = False
    errdesc.Text = ""
End If
setdate.Text = Format(daset.Value, "Long Date")
End Sub

Private Sub scset_click()
On Error GoTo err
Set ool = CreateObject("Outlook.Application")
Set oaa = ool.CreateItem(olAppointmentItem)
If NoticeExpired(ShortDate(setdate.Text), settime.Text) = True Then
    errdesc.Visible = True
    errdesc.Text = "Select Another Time"
    tiset.SetFocus
    GoTo byebye
Else
    errdesc.Visible = False
    errdesc.Text = ""
    GoTo submitme
End If

submitme:
    With oaa
        .Start = daset.Value & " " & tiset.Value
        .ReminderMinutesBeforeStart = 15
        .ReminderSet = True
        .Subject = "Call Back"
        .Body = "Call Back to: " & cid.Text & " - " & ctn.Text & vbCrLf & cph.Text & " or " & caph.Text & vbCrLf & deta.Text
        .Display
    End With
End Sub

[color green]'Found code on pscode.com[/color]
Sean
Register to rate this FAQ  : BAD 1 2 3 4 5 6 7 8 9 10 GOOD
Please Note: 1 is Bad, 10 is Good :-)

Part and Inventory Search

Back
Top