INTELLIGENT WORK FORUMS
FOR COMPUTER PROFESSIONALS

Log In

Come Join Us!

Are you a
Computer / IT professional?
Join Tek-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!

*Tek-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Jobs

Visual Basic (Microsoft) Versions 5/6 FAQ

VB Programming Concepts

Schedule Time/Date - Check Valid Time/Date by wizpooter
Posted: 8 Feb 03

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


'change nothing here
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


'change nothing here
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


'Found code on pscode.com
Sean

Back to Visual Basic (Microsoft) Versions 5/6 FAQ Index
Back to Visual Basic (Microsoft) Versions 5/6 Forum

My Archive

Resources

Close Box

Join Tek-Tips® Today!

Join your peers on the Internet's largest technical computer professional community.
It's easy to join and it's free.

Here's Why Members Love Tek-Tips Forums:

Register now while it's still free!

Already a member? Close this window and log in.

Join Us             Close