some help with sheridan calendar widgets please...

hi guys,
in vb6, i have a single form.
on it, i have the following controls.

command button
SSMonth Control (sheridan)
SS Day Control (sheridan)

I have the month control displayed above the day control on the form.
The form reads and writes from an ms access database which is named "samplecalendar.mdb"
the data base has only one table which is named "Main"
this table contains the following fields:
Date - Date/Time
BeginTime - Date/Time
EndTime - Date/Time
Description - Text

What I want to do is if there is an appt on a day, i want the month calendar to be colored , checkmarked or something to indicate that there is something happening on that day., or it
would be even nicer if it just displayed a number indicating how
many things are scheduled for that day.

the code I have behind the form and controls is this:

Code:

---


Private Sub Command1_Click()

    If SSDay1.X.Tasks.Count > 0 And SSDay1.TaskSelected > -1 Then
        Data1.Recordset.MoveFirst
        For i = 1 To SSDay1.TaskSelected
            Data1.Recordset.MoveNext
        Next i
        Data1.Recordset.Delete
        SSDay1.X.Tasks.Remove SSDay1.TaskSelected
    End If

End Sub

Private Sub Form_Load()
    Command1.Caption = "delete task"
End Sub

Private Sub SSDay1_CloseEdit(TaskIndex As Integer, Action As Integer, cancelled As Integer, changed As Integer)

    If changed And Not cancelled Then
        If Action = 0 Then
            Data1.Recordset.AddNew
            Data1.Recordset("Date") = SSMonth1.Date
            Data1.Recordset("Begintime") = SSDay1.X.Tasks(TaskIndex).BeginTime
            Data1.Recordset("Endtime") = SSDay1.X.Tasks(TaskIndex).EndTime
            Data1.Recordset("Description") = SSDay1.X.Tasks(TaskIndex).Text
            Data1.Recordset.Update
        Else
            Data1.Recordset.FindFirst "Begintime = #" & SSDay1.X.Tasks(TaskIndex).BeginTime & "# and Description ='" & SSDay1.X.Tasks(TaskIndex).Text & "'"
            Data1.Recordset.Edit
            Data1.Recordset("Date") = SSMonth1.Date
            Data1.Recordset("Begintime") = SSDay1.X.Tasks(TaskIndex).BeginTime
            Data1.Recordset("Endtime") = SSDay1.X.Tasks(TaskIndex).EndTime
            Data1.Recordset("Description") = SSDay1.X.Tasks(TaskIndex).Text
            Data1.Recordset.Update
        End If
    End If
   
End Sub

Private Sub SSDay1_DeleteTask(RtnCancel As Integer, RtnDispPromptMsg As Integer)
    Call Command1_Click
End Sub

Private Sub SSMonth1_SelChange(SelDate As String, OldSelDate As String, Selected As Integer, RtnCancel As Integer)

    SSDay1.X.Tasks.RemoveAll

    Data1.RecordSource = "Select * from Main where Date = #" & SelDate & "#"
    Data1.Refresh

    If Data1.Recordset.RecordCount > 0 Then
        Data1.Recordset.MoveFirst
        Do While Not Data1.Recordset.EOF
            SSDay1.X.Tasks.Add Data1.Recordset("BeginTime"), Data1.Recordset("EndTime"), Data1.Recordset("Description")
            Data1.Recordset.MoveNext
        Loop
    End If

End Sub

---

Well, u could use the styleset method of ssmonth. You can have a procedure like:
Private Sub CreateCalendarStylesets()
shmMontStyleSets.Add "DayCaptionAlignment"
shmMonth.StyleSets.Add "Meetings"
shmMonth.StyleSets.Add "Appointments"
shmMonth.StyleSets.Add "WeekEnd"
shmMonth.StyleSets.Add "WorkingDay"

shmMonth.StyleSets("DayCaptionAlignment").BackColor = shmMonth.BevelColorFace
shmMonth.StyleSets("DayCaptionAlignment").ForeColor = shmMonth.ForeColor
shmMonth.StyleSets("WorkingDay").BackColor = shmMonth.BevelColorFace
shmMonth.StyleSets("WorkingDay").ForeColor = shmMonth.ForeColor
shmMonth.StyleSets("WeekEnd").BackColor = shmMonth.BevelColorFace
shmMonth.StyleSets("WeekEnd").ForeColor = &HFF& 'Red
shmMonth.StyleSets("Meetings").BackColor = &H80FF80 'Green
shmMonth.StyleSets("Appointments").BackColor = &HFF& 'Red
end sub

U can then apply these stylesets on any day u want. The logic u have to sort out. U can also use the Tagvariant ptoperty of Monthview control. For e.g., if u have a recordset that fetches all appointments for a month, then u can add these days into the selected days collection. For each such day u can set the Tagvariant. For e.g:
If IsNull(shmMonth.SelectedDays(0).TagVariant) Then
shmMonth.SelectedDays(0).TagVariant = strApptName & "'" & lngApptID
Else
shmMonth.SelectedDays(0).TagVariant = shmMonth.SelectedDays(0).TagVariant & "''" & strApptName & "'" & lngApptID 'The single " ' " is used as a delimiter to separate a the appointment id and name of the same appointment. The double " '' " has been used to delimit each such occurence of an appointment. I have used this schema to handle multiple occurences of appointments on a single day.
End If

The above tagvariant information u can utilize to display a tooltip on a day that will highlight for e.g., "Presentation 0900 - 1200 hrs, Tech meeting 1500 - 1600 hrs" etc. on the month calendar. Ofcourse u have to do a little bit of programming in the mousemove event (see also DayFromPos property) of the month control to utilize the tagvariant information that has been stored earlier.

Hope u have grabbed the idea. Wishing u a good programming session!!

thank you very very much bhardwaj.

But, I am still a newbie at vb..
I have not figured out how to incorporate your code into my project.
Do I put it in the form or in a module.., and then how do I call it ?

thanks,
kevin

Sorry for being a bit late for the response. The code I have provided is an illustration of how to proceed for ur problem. U can create the CreateCalendarStyleSets procedure in ur form module and call it in the form_load event.

General Declarations
Dim mblnMarkCalenderInProgress as Boolean


Private sub Form_Load()
.
.

shmMonth.StartOfWeek = ssStartOfWeekSunday
shmMonth.SelectionType = ssSelectionTypeSingleSelect
shmMonth.AutoSelect = True
shmMonth.DefaultDate = Date
shmMonth.FocusDate = Date
shmMonth.Refresh

Call CreateCalendarStyleSets
.
.
Call MarkEventsOnYearCalendar(Date);
.
.
End Sub

Private Sub MarkEventsOnMonthCalendar(ByVal strSelDate As String)
'First clear the selected days collection and reset each day of the current month. Then fire query to fetch all events for the current month. Once done this, apply the fetched information on applicable days.

Dim intMonth As Integer
Dim intYear As Integer

Dim strTempStartDate As String
Dim strTempEndDate As String
Dim strEventName As String
Dim strEventType As String

Dim lngEventID As Long

On Error GoTo ErrorHandler_MarkEventsOnMonthCalendar

mblnMarkCalenderInProgress = True

'Clear the settings of the Month of strSelDate
intMonth = Month(strSelDate)
intYear = Year(strSelDate)
strTempStartDate = DateSerial(intYear, intMonth, 1) 'First day of the intMonth
strTempEndDate = DateSerial(intYear, intMonth + 1, 0) 'Last day of the intMonth

If shmMonth.SelectedDays.Count > 0 Then
shmMonth.SelectedDays.Remove 0
End If

While DateDiff("d", strTempStartDate, strTempEndDate, vbSunday) >= 0
shmMonth.SelectedDays.Add strTempStartDate
shmMonth.SelectedDays(0).TagVariant = Null
shmMonth.SelectedDays(0).Caption = ""

If Weekday(shmMonth.SelectedDays(0).Date) = 1 Or Weekday(shmMonth.SelectedDays(0).Date) = 7 Then
shmMonth.SelectedDays(0).StyleSet = "WeekEnd"
Else
shmMonth.SelectedDays(0).StyleSet = "WorkingDay"
End If

shmMonth.SelectedDays.Remove 0
strTempStartDate = DateAdd("d", 1, strTempStartDate)
Wend

'Write here query to fetch event data for the current month. Create a recordset, say: objRecordSet
While Not objRecordSet.EOF
strEventName = objRecordSet!EventName
strEventType = objRecordSet!EventType
lngEventID = objRecordSet!EventID
strDueDate = objRecordSet!EventDueDate


If shmMonth.SelectedDays.Count > 0 Then
shmMonth.SelectedDays.Remove 0
End If

shmMonth.SelectedDays.Add strDueDate
shmMonth.SelectedDays(0).Enabled = True

If IsNull(shmMonth.SelectedDays(0).TagVariant) Then
shmMonth.SelectedDays(0).TagVariant = strEventName & "'" & lngEventID
Else
shmMonth.SelectedDays(0).TagVariant = shmMonth.SelectedDays(0).TagVariant & "''" & strEventName & "'" & lngEventID
End If

If shmMonth.SelectedDays(0).StyleSet <> "WorkingDay" And shmMonth.SelectedDays(0).StyleSet <> "WeekEnd" Then
shmMonth.SelectedDays(0).StyleSet = "MultipleEvents"
Else
shmMonth.SelectedDays(0).StyleSet = strEventType
Endif

objRecordSet.MoveNext
Wend

If Not objRecordSet Is Nothing Then
If objRecordSet.State <> adStateClosed Then
'Close Recordset
objRecordSet.Close
End If

'Release Recordset FROM memory
Set objRecordSet = Nothing
End If

If shmMonth.SelectedDays.Count > 0 Then
shmMonth.SelectedDays.Remove 0
End If

shmMonth.FocusDate = strSelDate
mblnMarkCalenderInProgress = False

Exit Sub

ErrorHandler_MarkEventsOnMonthCalendar:
If Not objRecordSet Is Nothing Then
If objRecordSet.State <> adStateClosed Then
'Close Recordset
objRecordSet.Close
End If

'Release Recordset FROM memory
Set objRecordSet = Nothing
End If

mblnMarkCalenderInProgress = False
End Sub

Private Sub shmMonth_FocusChange(FocusDate As String, OldFocusDate As String, MonthNum As Integer, YearNum As Integer, DayNum As Integer)
If Me.Visible And mblnMarkCalenderInProgress = False Then
'If the year or month has changed then populate the selected month of the new year with all the events

If (Year(FocusDate) <> Year(OldFocusDate)) Or (Month(FocusDate) <> Month(OldFocusDate)) Then
Call MarkEventsOnMonthCalendar(FocusDate)
End If

shmMonth.SelectedDays.Add FocusDate
End If
End Sub

Private Sub shmMonth_InitMonth(MonthNum As Integer, YearNum As Integer, RtnCancel As Integer)
shmMonth.Refresh
End Sub

Remember this is just an example of how u can get along with ur problem. U have to make changes in the above procedures according to ur requirement. Try to catch the logic.

Hope it works!!

Hi there is a minor correction. I had called proc: MarkEventsOnYearCalendar in Form Load. It is a typing mistake. Call MarkEventsOnMonthCalendar instead.

Bye!!

i think i am getting closer.., thank you so much for your help..
it seems to highlight the weekdays and weekends with different colors, but it is not doing it for the days that have something scheduled..
here is the full code in the form that i have so far:
again, thank you so much for your help.
kevin

Code:

---


Dim mblnMarkCalenderInProgress As Boolean
Private Sub CreateCalendarStylesets()
SSMonth1.StyleSets.Add "DayCaptionAlignment"
SSMonth1.StyleSets.Add "Meetings"
SSMonth1.StyleSets.Add "Appointments"
SSMonth1.StyleSets.Add "WeekEnd"
SSMonth1.StyleSets.Add "WorkingDay"

SSMonth1.StyleSets("DayCaptionAlignment").BackColor = SSMonth1.BevelColorFace
SSMonth1.StyleSets("DayCaptionAlignment").ForeColor = SSMonth1.ForeColor
SSMonth1.StyleSets("WorkingDay").BackColor = SSMonth1.BevelColorFace
SSMonth1.StyleSets("WorkingDay").ForeColor = SSMonth1.ForeColor
SSMonth1.StyleSets("WeekEnd").BackColor = SSMonth1.BevelColorFace
SSMonth1.StyleSets("WeekEnd").ForeColor = &HFF& 'Red
SSMonth1.StyleSets("Meetings").BackColor = &H80FF80 'Green
SSMonth1.StyleSets("Appointments").BackColor = &HFF& 'Red
End Sub
Private Sub MarkEventsOnMonthCalendar(ByVal strSelDate As String)
'First clear the selected days collection and reset each day of the current month. Then fire query to fetch all events for the current month. Once done this, apply the fetched information on applicable days.

Dim intMonth As Integer
Dim intYear As Integer

Dim strTempStartDate As String
Dim strTempEndDate As String
Dim strEventName As String
Dim strEventType As String

Dim lngEventID As Long

'On Error GoTo ErrorHandler_MarkEventsOnMonthCalendar
'On Error Resume Next

mblnMarkCalenderInProgress = True

'Clear the settings of the Month of strSelDate
intMonth = Month(strSelDate)
intYear = Year(strSelDate)
strTempStartDate = DateSerial(intYear, intMonth, 1) 'First day of the intMonth
strTempEndDate = DateSerial(intYear, intMonth + 1, 0) 'Last day of the intMonth

If SSMonth1.SelectedDays.Count > 0 Then
SSMonth1.SelectedDays.Remove 0
End If

While DateDiff("d", strTempStartDate, strTempEndDate, vbSunday) >= 0
SSMonth1.SelectedDays.Add strTempStartDate
SSMonth1.SelectedDays(0).TagVariant = Null
SSMonth1.SelectedDays(0).Caption = ""

If Weekday(SSMonth1.SelectedDays(0).Date) = 1 Or Weekday(SSMonth1.SelectedDays(0).Date) = 7 Then
SSMonth1.SelectedDays(0).StyleSet = "WeekEnd"
Else
SSMonth1.SelectedDays(0).StyleSet = "WorkingDay"
End If

SSMonth1.SelectedDays.Remove 0
strTempStartDate = DateAdd("d", 1, strTempStartDate)
Wend

'Write here query to fetch event data for the current month. Create a recordset
'say: data1.Recordset
While Not Data1.Recordset.EOF
While Not Data1.Recordset.EOF

strEventName = Data1.Recordset!EventName
strEventType = Data1.Recordset!EventType
lngEventID = Data1.Recordset!EventID
strDueDate = Data1.Recordset!EventDueDate


If SSMonth1.SelectedDays.Count > 0 Then
SSMonth1.SelectedDays.Remove 0
End If

SSMonth1.SelectedDays.Add strDueDate
SSMonth1.SelectedDays(0).Enabled = True

If IsNull(SSMonth1.SelectedDays(0).TagVariant) Then
SSMonth1.SelectedDays(0).TagVariant = strEventName & "'" & lngEventID
Else
SSMonth1.SelectedDays(0).TagVariant = SSMonth1.SelectedDays(0).TagVariant & "''" & strEventName & "'" & lngEventID
End If

If SSMonth1.SelectedDays(0).StyleSet <> "WorkingDay" And SSMonth1.SelectedDays(0).StyleSet <> "WeekEnd" Then
SSMonth1.SelectedDays(0).StyleSet = "MultipleEvents"
Else
SSMonth1.SelectedDays(0).StyleSet = strEventType
End If

Data1.Recordset.MoveNext
Wend

If Not Data1.Recordset Is Nothing Then
If Data1.Recordset.State <> adStateClosed Then
'Close Recordset
Data1.Recordset.Close
End If

'Release Recordset FROM memory
Set Data1.Recordset = Nothing
End If

If SSMonth1.SelectedDays.Count > 0 Then
SSMonth1.SelectedDays.Remove 0
End If

SSMonth1.FocusDate = strSelDate
mblnMarkCalenderInProgress = False

Exit Sub

'ErrorHandler_MarkEventsOnMonthCalendar:
'If Not data1.Recordset Is Nothing Then
If Data1.Recordset.State <> adStateClosed Then
'Close Recordset
'data1.Recordset.Close
'End If

'Release Recordset FROM memory
Set Data1.Recordset = Nothing
End If
Wend

mblnMarkCalenderInProgress = False
End Sub
Private Sub Command1_Click()

    If SSDay1.X.Tasks.Count > 0 And SSDay1.TaskSelected > -1 Then
        Data1.Recordset.MoveFirst
        For i = 1 To SSDay1.TaskSelected
            Data1.Recordset.MoveNext
        Next i
        Data1.Recordset.Delete
        SSDay1.X.Tasks.Remove SSDay1.TaskSelected
    End If

End Sub
Private Sub Form_Load()
    Command1.Caption = "delete task"
   
    SSMonth1.Date = Date
   
    SSMonth1.StartOfWeek = ssStartOfWeekSunday
    SSMonth1.SelectionType = ssSelectionTypeSingleSelect
    SSMonth1.AutoSelect = True
    SSMonth1.DefaultDate = Date
    SSMonth1.FocusDate = Date
    SSMonth1.Refresh

Call CreateCalendarStylesets

Call MarkEventsOnMonthCalendar(Date)

End Sub

Private Sub SSMonth1_FocusChange(FocusDate As String, OldFocusDate As String, MonthNum As Integer, YearNum As Integer, DayNum As Integer)
If Me.Visible And mblnMarkCalenderInProgress = False Then
'If the year or month has changed then populate the selected month of the new year with all the events

If (Year(FocusDate) <> Year(OldFocusDate)) Or (Month(FocusDate) <> Month(OldFocusDate)) Then
Call MarkEventsOnMonthCalendar(FocusDate)
End If

SSMonth1.SelectedDays.Add FocusDate
End If
End Sub

Private Sub SSMonth1_InitMonth(MonthNum As Integer, YearNum As Integer, RtnCancel As Integer)
SSMonth1.Refresh
End Sub

Private Sub SSDay1_CloseEdit(TaskIndex As Integer, Action As Integer, cancelled As Integer, changed As Integer)

    If changed And Not cancelled Then
        If Action = 0 Then
            Data1.Recordset.AddNew
            Data1.Recordset("Date") = SSMonth1.Date
            Data1.Recordset("Begintime") = SSDay1.X.Tasks(TaskIndex).BeginTime
            Data1.Recordset("Endtime") = SSDay1.X.Tasks(TaskIndex).EndTime
            Data1.Recordset("Description") = SSDay1.X.Tasks(TaskIndex).Text
            Data1.Recordset.Update
        Else
            Data1.Recordset.FindFirst "Begintime = #" & SSDay1.X.Tasks(TaskIndex).BeginTime & "# and Description ='" & SSDay1.X.Tasks(TaskIndex).Text & "'"
            Data1.Recordset.Edit
            Data1.Recordset("Date") = SSMonth1.Date
            Data1.Recordset("Begintime") = SSDay1.X.Tasks(TaskIndex).BeginTime
            Data1.Recordset("Endtime") = SSDay1.X.Tasks(TaskIndex).EndTime
            Data1.Recordset("Description") = SSDay1.X.Tasks(TaskIndex).Text
            Data1.Recordset.Update
        End If
    End If
   
End Sub

Private Sub SSDay1_DeleteTask(RtnCancel As Integer, RtnDispPromptMsg As Integer)
    Call Command1_Click
End Sub

Private Sub SSMonth1_SelChange(SelDate As String, OldSelDate As String, Selected As Integer, RtnCancel As Integer)

    SSDay1.X.Tasks.RemoveAll

    Data1.RecordSource = "Select * from Main where Date = #" & SelDate & "#"
    Data1.Refresh

    If Data1.Recordset.RecordCount > 0 Then
        Data1.Recordset.MoveFirst
        Do While Not Data1.Recordset.EOF
            SSDay1.X.Tasks.Add Data1.Recordset("BeginTime"), Data1.Recordset("EndTime"), Data1.Recordset("Description")
            Data1.Recordset.MoveNext
        Loop
    End If

End Sub

---

Please confirm the following:
Are u first testing the code I have provided? or have u integrated it with ur stuff?

Well if u r testing my code then u have to have the following tables in ur database:
Table: EventArchive: Will store the info about the events for e.g, meetings, appointments etc
-------
Name Type Description
------- -----
EventID Integer Primary Key column
EventName VarChar(50) Name of the event
EventTypeID Integer Foreign Key to EventType.EventTypeID
DueDate DateTime The due date of the event

Table: EventType: Will store the the type of events for e.g., meetings, appointments etc
-----
Name Type Description
------- -----
EventTypeID Integer Primary Key column
EventType VarChar(50) Identifies Eventtype viz., Meeting, Appointment etc.

So the query in the MarkEventsOnMonthCalendar procedure will look something like:
strSQL = "SELECT EA.EventID, EA.EventName, EA.DueDate, ET.EventType FROM EventArchive EA, EventType ET"
strSQL = strSQL & " WHERE EA.EventTypeID = ET.EventTypeID AND Month(EA.DueDate) = Month('" & strSelDate
strSQL = strSQL & "') And Year(EA.DueDate) = Year('" & strSelDate & "') Order By EA.DueDate"

If u want to incorporate my code in ur stuff, then priority should be given to ur requirements. What I mean to say is u should create as many stylesets as the number of event types u can have for e.g., holiday, meetings, appointments etc. U can have different combination of Forecolor, Backcolor etc for each of these stylesets. So that when u fetch events for a particular month using the proc: MarkEventsOnMonthCalendar, u can set ur selected days collection styleset property set accordingly. There might be a case when in a single day, u can have more than one event. U can have a separate Styleset: MultipleEvents. The code in proc: MarkEventsOnMonthCalendar handles this situation:
If SSMonth1.SelectedDays(0).StyleSet <> "WorkingDay" And SSMonth1.SelectedDays(0).StyleSet <> "WeekEnd" Then
SSMonth1.SelectedDays(0).StyleSet = "MultipleEvents"
Else
SSMonth1.SelectedDays(0).StyleSet = strEventType
End If

We are assuming the default styleset to be either one of "WorkingDay" or "WeekEnd".

I suppose u have sufficient information to test my code.

As far as ur code is concerned, U said u have only one table: Main. Ok rename it as EventArchieve. Rename Date field as DueDate. Add other fields to this table that I have listed above. Add another table EventType as listed above. Provide an interface from ur application GUI from where the user can define EventTypes. Store these eventtypes in EventType table. Rename ur Monthview control SSMonth1 to shmMonth

Alter ur event procedure: SSDay1_CloseEdit to something like:

Private Sub SSDay1_CloseEdit(TaskIndex As Integer, Action As Integer, cancelled As Integer, changed As Integer)

If changed And Not cancelled Then
shmMonth.Enabled=False

If Action = 0 Then
Data1.Recordset.AddNew
Data1.Recordset("DueDate") = shmMonth.FocusDate
Data1.Recordset("Begintime") = SSDay1.X.Tasks(TaskIndex).BeginTime
Data1.Recordset("Endtime") = SSDay1.X.Tasks(TaskIndex).EndTime
Data1.Recordset("Description") = SSDay1.X.Tasks(TaskIndex).Text
Data1.Recordset.Update
Else
Data1.Recordset.FindFirst "Begintime = #" & SSDay1.X.Tasks(TaskIndex).BeginTime & "# and Description ='" & SSDay1.X.Tasks(TaskIndex).Text & "'"
Data1.Recordset.Edit
Data1.Recordset("DueDate") = shmMonth.FocusDate
Data1.Recordset("Begintime") = SSDay1.X.Tasks(TaskIndex).BeginTime
Data1.Recordset("Endtime") = SSDay1.X.Tasks(TaskIndex).EndTime
Data1.Recordset("Description") = SSDay1.X.Tasks(TaskIndex).Text
Data1.Recordset.Update
End If

Call subMarkEventsOnMonthCalendar(shmMonth.FocusDate)

shmMonth.SelectedDays.Add shmMonth.FocusDate

shmMonth.Enabled=True
End If

End Sub

Rgds,

I have intetgrated into my program.
the code i posted is the whole program with your code in it.

ok, here is what i have so far.. i still can not get the appt days to highlight... only the weekend and week days are highlighting..

Code:

---

Dim mblnMarkCalenderInProgress As Boolean
Private sSelectedMonth As String

Private Sub CreateCalendarStylesets()
shmMonth.StyleSets.Add "DayCaptionAlignment"
shmMonth.StyleSets.Add "Meetings"
shmMonth.StyleSets.Add "WeekEnd"
shmMonth.StyleSets.Add "WorkingDay"
shmMonth.StyleSets.Add "Charter"

shmMonth.StyleSets("DayCaptionAlignment").BackColor = shmMonth.BevelColorFace
shmMonth.StyleSets("DayCaptionAlignment").ForeColor = shmMonth.ForeColor
shmMonth.StyleSets("WorkingDay").BackColor = shmMonth.BevelColorFace
shmMonth.StyleSets("WorkingDay").ForeColor = shmMonth.ForeColor
shmMonth.StyleSets("WeekEnd").BackColor = shmMonth.BevelColorFace
shmMonth.StyleSets("WeekEnd").ForeColor = &HFF& 'Red
shmMonth.StyleSets("Meetings").BackColor = &H80FF80 'Green
shmMonth.StyleSets("Charter").BackColor = &HFF& 'Red
End Sub
Private Sub MarkEventsOnMonthCalendar(ByVal strSelDate As String)
'First clear the selected days collection and reset each day of the current month. Then fire query to fetch all events for the current month. Once done this, apply the fetched information on applicable days.

Dim intMonth As Integer
Dim intYear As Integer

Dim strTempStartDate As String
Dim strTempEndDate As String
Dim strEventName As String
Dim strEventType As String
Dim lngEventID As Long

'On Error GoTo ErrorHandler_MarkEventsOnMonthCalendar
On Error Resume Next

strSQL = "SELECT EventID, EventName, DueDate, EventType, BeginTime, EndTime FROM EventArchive, EventType"
strSQL = strSQL & " WHERE EventTypeID = EventTypeID AND Month(DueDate) = Month('" & strSelDate
strSQL = strSQL & "') And Year(DueDate) = Year('" & strSelDate & "') Order By DueDate"

mblnMarkCalenderInProgress = True

'Clear the settings of the Month of strSelDate
intMonth = Month(strSelDate)
intYear = Year(strSelDate)
strTempStartDate = DateSerial(intYear, intMonth, 1) 'First day of the intMonth
strTempEndDate = DateSerial(intYear, intMonth + 1, 0) 'Last day of the intMonth

If shmMonth.SelectedDays.Count > 0 Then
shmMonth.SelectedDays.Remove 0
End If

While DateDiff("d", strTempStartDate, strTempEndDate, vbSunday) >= 0
shmMonth.SelectedDays.Add strTempStartDate
shmMonth.SelectedDays(0).TagVariant = Null
shmMonth.SelectedDays(0).Caption = ""

'markings for days are here

If Weekday(shmMonth.SelectedDays(0).Date) = 1 Or Weekday(shmMonth.SelectedDays(0).Date) = 7 Then
shmMonth.SelectedDays(0).StyleSet = "WeekEnd"
Else
shmMonth.SelectedDays(0).StyleSet = "Weekday"

End If

shmMonth.SelectedDays.Remove 0
strTempStartDate = DateAdd("d", 1, strTempStartDate)
Wend

'Write here query to fetch event data for the current month. Create a recordset
'say: data1.Recordset
While Not Data1.Recordset.EOF
While Not Data1.Recordset.EOF

strEventName = Data1.Recordset!EventName
strEventType = Data1.Recordset!EventType
lngEventID = Data1.Recordset!EventID
strDueDate = Data1.Recordset!EventDueDate


If shmMonth.SelectedDays.Count > 0 Then
shmMonth.SelectedDays.Remove 0
End If

shmMonth.SelectedDays.Add strDueDate
shmMonth.SelectedDays(0).Enabled = True

If IsNull(shmMonth.SelectedDays(0).TagVariant) Then
shmMonth.SelectedDays(0).TagVariant = strEventName & "'" & lngEventID
Else
shmMonth.SelectedDays(0).TagVariant = shmMonth.SelectedDays(0).TagVariant & "''" & strEventName & "'" & lngEventID
End If

If shmMonth.SelectedDays(0).StyleSet <> "WorkingDay" And shmMonth.SelectedDays(0).StyleSet <> "WeekEnd" Then
shmMonth.SelectedDays(0).StyleSet = "MultipleEvents"
Else
'shmMonth.SelectedDays(0).StyleSet = strEventType
shmMonth.SelectedDays(0).StyleSet = Charter
End If

Data1.Recordset.MoveNext
Wend

If Not Data1.Recordset Is Nothing Then
If Data1.Recordset.State <> adStateClosed Then
'Close Recordset
Data1.Recordset.Close
End If

'Release Recordset FROM memory
Set Data1.Recordset = Nothing
End If

If shmMonth.SelectedDays.Count > 0 Then
shmMonth.SelectedDays.Remove 0
End If

shmMonth.FocusDate = strSelDate
mblnMarkCalenderInProgress = False

Exit Sub

'ErrorHandler_MarkEventsOnMonthCalendar:
'If Not data1.Recordset Is Nothing Then
If Data1.Recordset.State <> adStateClosed Then
'Close Recordset
'data1.Recordset.Close
'End If

'Release Recordset FROM memory
Set Data1.Recordset = Nothing
End If
Wend

mblnMarkCalenderInProgress = False
End Sub

Private Sub cboMonth_Click()
   
    sSelectedMonth = cboMonth.Text
           
End Sub

Private Sub Command1_Click()

    If SSDay1.X.Tasks.Count > 0 And SSDay1.TaskSelected > -1 Then
        Data1.Recordset.MoveFirst
        For i = 1 To SSDay1.TaskSelected
            Data1.Recordset.MoveNext
        Next i
        Data1.Recordset.Delete
        SSDay1.X.Tasks.Remove SSDay1.TaskSelected
    End If

End Sub

Private Sub Form_Load()
    Command1.Caption = "delete task"
   
    shmMonth.Date = Date
    Me.appttype.Text = "Charter"
    shmMonth.StartOfWeek = ssStartOfWeekSunday
    shmMonth.SelectionType = ssSelectionTypeSingleSelect
    shmMonth.AutoSelect = True
    shmMonth.DefaultDate = Date
    shmMonth.FocusDate = Date
    shmMonth.Refresh

Call CreateCalendarStylesets

Call MarkEventsOnMonthCalendar(Date)

    cboMonth.AddItem "January"
    cboMonth.AddItem "February"
    cboMonth.AddItem "March"
    cboMonth.AddItem "April"
    cboMonth.AddItem "May"
    cboMonth.AddItem "June"
    cboMonth.AddItem "July"
    cboMonth.AddItem "August"
    cboMonth.AddItem "September"
    cboMonth.AddItem "October"
    cboMonth.AddItem "November"
    cboMonth.AddItem "December"
    cboMonth.Text = "January"
   
End Sub

Private Sub shmMonth_FocusChange(FocusDate As String, OldFocusDate As String, MonthNum As Integer, YearNum As Integer, DayNum As Integer)
If Me.Visible And mblnMarkCalenderInProgress = False Then
'If the year or month has changed then populate the selected month of the new year with all the events

If (Year(FocusDate) <> Year(OldFocusDate)) Or (Month(FocusDate) <> Month(OldFocusDate)) Then
Call MarkEventsOnMonthCalendar(FocusDate)
End If

shmMonth.SelectedDays.Add FocusDate
End If
End Sub

Private Sub shmMonth_InitMonth(MonthNum As Integer, YearNum As Integer, RtnCancel As Integer)
shmMonth.Refresh
End Sub

Private Sub SSDay1_CloseEdit(TaskIndex As Integer, Action As Integer, cancelled As Integer, changed As Integer)

If changed And Not cancelled Then
shmMonth.Enabled = False

If Action = 0 Then
Form1.appttype.Text = Form2.List1.Text
    Unload Form2
Data1.Recordset.AddNew
Data1.Recordset("DueDate") = shmMonth.FocusDate
Data1.Recordset("Begintime") = SSDay1.X.Tasks(TaskIndex).BeginTime
Data1.Recordset("Endtime") = SSDay1.X.Tasks(TaskIndex).EndTime
Data1.Recordset("EventName") = SSDay1.X.Tasks(TaskIndex).Text
Data1.Recordset("EventType") = Me.appttype.Text
Data1.Recordset.Update
Else
Form1.appttype.Text = Form2.List1.Text
    Unload Form2
Data1.Recordset.FindFirst "Begintime = #" & SSDay1.X.Tasks(TaskIndex).BeginTime & "# and EventName ='" & SSDay1.X.Tasks(TaskIndex).Text & "'"
Data1.Recordset.Edit
Data1.Recordset("DueDate") = shmMonth.FocusDate
Data1.Recordset("Begintime") = SSDay1.X.Tasks(TaskIndex).BeginTime
Data1.Recordset("Endtime") = SSDay1.X.Tasks(TaskIndex).EndTime
Data1.Recordset("EventName") = SSDay1.X.Tasks(TaskIndex).Text
Data1.Recordset("EventType") = Me.appttype.Text
Data1.Recordset.Update
End If

Call MarkEventsOnMonthCalendar(shmMonth.FocusDate)

shmMonth.SelectedDays.Add shmMonth.FocusDate

shmMonth.Enabled = True
End If

End Sub

Private Sub SSDay1_DeleteTask(RtnCancel As Integer, RtnDispPromptMsg As Integer)
    Call Command1_Click
End Sub

Private Sub shmMonth_SelChange(SelDate As String, OldSelDate As String, Selected As Integer, RtnCancel As Integer)

    SSDay1.X.Tasks.RemoveAll

    Data1.RecordSource = "Select * from EventArchive where DueDate = #" & SelDate & "#"
    Data1.Refresh

    If Data1.Recordset.RecordCount > 0 Then
        Data1.Recordset.MoveFirst
        Do While Not Data1.Recordset.EOF
            SSDay1.X.Tasks.Add Data1.Recordset("BeginTime"), Data1.Recordset("EndTime"), Data1.Recordset("EventName")
                       
            Data1.Recordset.MoveNext
        Loop
    End If

End Sub

---

did you go ???

Hi Kevin, I was busy in the last few days so couldn't keep track of ur progress. Well, I saw the code u last posted. Please don't mind if I say that u never bothered to scan the code for bugs. U have to check the procedure: MarkEventsOnMonthCalendar. U have inserted the query strSQL = "..., but did not bother to create a recordset using this query. If u do not create a recordset in the first place how do u expect to retrieve records from the database. This is the first problem. The second problem is that u have used the while statement (While Not Data1.Recordset.EOF
) two times in the same procedure. Thirdly, never use On error resume next statement. If u do this u will never be announced errors by VB. So uncomment the line On error goto ...

I would advise u to create an ADO recordset using the query stored in strSQL. I presume that u know how to create an ADO recordset. Name this recordset say, objRecordset. Replace Data1.Recordset with objRecordset at all occurences in this procedure. And then tell me if ur code does not work.

Good luck!
Kamal

thank you for your patience and help..
here is what I have so far...
it is not highlighting the events yet...
remember, i really am a beginner at this still...,

kevin

Code:

---

Dim mblnMarkCalenderInProgress As Boolean
Private sSelectedMonth As String

Private Sub CreateCalendarStylesets()
shmMonth.StyleSets.Add "DayCaptionAlignment"
shmMonth.StyleSets.Add "Meetings"
shmMonth.StyleSets.Add "WeekEnd"
shmMonth.StyleSets.Add "WorkingDay"
shmMonth.StyleSets.Add "Charter"

shmMonth.StyleSets("DayCaptionAlignment").BackColor = shmMonth.BevelColorFace
shmMonth.StyleSets("DayCaptionAlignment").ForeColor = shmMonth.ForeColor
shmMonth.StyleSets("WorkingDay").BackColor = shmMonth.BevelColorFace
shmMonth.StyleSets("WorkingDay").ForeColor = shmMonth.ForeColor
shmMonth.StyleSets("WeekEnd").BackColor = shmMonth.BevelColorFace
shmMonth.StyleSets("WeekEnd").ForeColor = &HFF& 'Red
shmMonth.StyleSets("Meetings").BackColor = &H80FF80 'Green
shmMonth.StyleSets("Charter").BackColor = &HFF& 'Red
End Sub
Private Sub MarkEventsOnMonthCalendar(ByVal strSelDate As String)
'First clear the selected days collection and reset each day of the current month. Then fire query to fetch all events for the current month. Once done this, apply the fetched information on applicable days.

Dim intMonth As Integer
Dim intYear As Integer

Dim strTempStartDate As String
Dim strTempEndDate As String
Dim strEventName As String
Dim strEventType As String
Dim lngEventID As Long

On Error GoTo ErrorHandler_MarkEventsOnMonthCalendar
'On Error Resume Next

strSQL = "SELECT EventID, EventName, DueDate, EventType, BeginTime, EndTime FROM tblEventArchive, EventType"
strSQL = strSQL & " WHERE EventTypeID = EventTypeID AND Month(DueDate) = Month('" & strSelDate
strSQL = strSQL & "') And Year(DueDate) = Year('" & strSelDate & "') Order By DueDate"

mblnMarkCalenderInProgress = True

'Clear the settings of the Month of strSelDate
intMonth = Month(strSelDate)
intYear = Year(strSelDate)
strTempStartDate = DateSerial(intYear, intMonth, 1) 'First day of the intMonth
strTempEndDate = DateSerial(intYear, intMonth + 1, 0) 'Last day of the intMonth

If shmMonth.SelectedDays.Count > 0 Then
shmMonth.SelectedDays.Remove 0
End If

While DateDiff("d", strTempStartDate, strTempEndDate, vbSunday) >= 0
shmMonth.SelectedDays.Add strTempStartDate
shmMonth.SelectedDays(0).TagVariant = Null
shmMonth.SelectedDays(0).Caption = ""

'markings for days are here

If Weekday(shmMonth.SelectedDays(0).Date) = 1 Or Weekday(shmMonth.SelectedDays(0).Date) = 7 Then
shmMonth.SelectedDays(0).StyleSet = "WeekEnd"
Else
shmMonth.SelectedDays(0).StyleSet = "Weekday"

End If

shmMonth.SelectedDays.Remove 0
strTempStartDate = DateAdd("d", 1, strTempStartDate)
Wend

'Write here query to fetch event data for the current month. Create a recordset
'say: objRecordset
While Not objRecordset.Recordset.EOF

strEventName = objRecordset.Recordset!EventName
strEventType = objRecordset.Recordset!EventType
lngEventID = objRecordset.Recordset!EventID
strDueDate = objRecordset.Recordset!EventDueDate


If shmMonth.SelectedDays.Count > 0 Then
shmMonth.SelectedDays.Remove 0
End If

shmMonth.SelectedDays.Add strDueDate
shmMonth.SelectedDays(0).Enabled = True

If IsNull(shmMonth.SelectedDays(0).TagVariant) Then
shmMonth.SelectedDays(0).TagVariant = strEventName & "'" & lngEventID
Else
shmMonth.SelectedDays(0).TagVariant = shmMonth.SelectedDays(0).TagVariant & "''" & strEventName & "'" & lngEventID
End If

If shmMonth.SelectedDays(0).StyleSet <> "WorkingDay" And shmMonth.SelectedDays(0).StyleSet <> "WeekEnd" Then
shmMonth.SelectedDays(0).StyleSet = "MultipleEvents"
Else
'shmMonth.SelectedDays(0).StyleSet = strEventType
shmMonth.SelectedDays(0).StyleSet = Charter
End If

objRecordset.Recordset.MoveNext
Wend

If Not objRecordset Is Nothing Then
If objRecordset.Recordset.Type <> adStateClosed Then
'Close Recordset
objRecordset.Recordset.Close
End If

'Release Recordset FROM memory
Set objRecordset.Recordset = Nothing
End If

If shmMonth.SelectedDays.Count > 0 Then
shmMonth.SelectedDays.Remove 0
End If

shmMonth.FocusDate = strSelDate
mblnMarkCalenderInProgress = False

Exit Sub

ErrorHandler_MarkEventsOnMonthCalendar:
If Not objRecordset Is Nothing Then
'If objRecordset.State <> adStateClosed Then

Close Recordset
objRecordset.Recordset.Close
End If

'Release Recordset FROM memory
Set objRecordset.Recordset = Nothing

mblnMarkCalenderInProgress = False
End Sub

Private Sub cboMonth_Click()
   
    sSelectedMonth = cboMonth.Text
           
End Sub

Private Sub Command1_Click()

    If SSDay1.X.Tasks.Count > 0 And SSDay1.TaskSelected > -1 Then
        objRecordset.MoveFirst
        For i = 1 To SSDay1.TaskSelected
            objRecordset.MoveNext
        Next i
        objRecordset.Delete
        SSDay1.X.Tasks.Remove SSDay1.TaskSelected
    End If

End Sub

Private Sub Form_Load()
   
Dim adoConn As ADODB.Connection
Dim objRecordset As ADODB.Recordset


  Set adoConn = New ADODB.Connection
  adoConn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
      "Data Source= " & App.Path & "\samplecalendar.mdb"
  adoConn.Open
 
  Set objRecordset = New ADODB.Recordset
  objRecordset.Open "tblEventArchive", adoConn, adOpenKeyset, adLockPessimistic, adCmdTable
   
    Command1.Caption = "delete task"
   
    shmMonth.Date = Date
    shmMonth.StartOfWeek = ssStartOfWeekSunday
    shmMonth.SelectionType = ssSelectionTypeSingleSelect
    shmMonth.AutoSelect = True
    shmMonth.DefaultDate = Date
    shmMonth.FocusDate = Date
    shmMonth.Refresh

Call CreateCalendarStylesets
Call MarkEventsOnMonthCalendar(Date)
    cboMonth.AddItem "January"
    cboMonth.AddItem "February"
    cboMonth.AddItem "March"
    cboMonth.AddItem "April"
    cboMonth.AddItem "May"
    cboMonth.AddItem "June"
    cboMonth.AddItem "July"
    cboMonth.AddItem "August"
    cboMonth.AddItem "September"
    cboMonth.AddItem "October"
    cboMonth.AddItem "November"
    cboMonth.AddItem "December"
    cboMonth.Text = "January"


End Sub

Private Sub Form_Unload(Cancel As Integer)
  Set adoConn = Nothing
  Set objRecordset.Recordset = Nothing
End Sub

Private Sub shmMonth_FocusChange(FocusDate As String, OldFocusDate As String, MonthNum As Integer, YearNum As Integer, DayNum As Integer)
If Me.Visible And mblnMarkCalenderInProgress = False Then
'If the year or month has changed then populate the selected month of the new year with all the events

If (Year(FocusDate) <> Year(OldFocusDate)) Or (Month(FocusDate) <> Month(OldFocusDate)) Then
Call MarkEventsOnMonthCalendar(FocusDate)
End If

shmMonth.SelectedDays.Add FocusDate
End If
End Sub

Private Sub shmMonth_InitMonth(MonthNum As Integer, YearNum As Integer, RtnCancel As Integer)
shmMonth.Refresh
End Sub

Private Sub SSDay1_CloseEdit(TaskIndex As Integer, Action As Integer, cancelled As Integer, changed As Integer)

If changed And Not cancelled Then
shmMonth.Enabled = False

If Action = 0 Then
objRecordset.Recordset.AddNew
objRecordset.Recordset("DueDate") = shmMonth.FocusDate
objRecordset.Recordset("Begintime") = SSDay1.X.Tasks(TaskIndex).BeginTime

objRecordset.Recordset("Endtime") = SSDay1.X.Tasks(TaskIndex).EndTime
objRecordset.Recordset("EventName") = SSDay1.X.Tasks(TaskIndex).Text
'objRecordset.Recordset("EventType") = Me.appttype.Text
objRecordset.Recordset.Update
Else

objRecordset.Recordset.FindFirst "Begintime = #" & SSDay1.X.Tasks(TaskIndex).BeginTime & "# and EventName ='" & SSDay1.X.Tasks(TaskIndex).Text & "'"
objRecordset.Recordset.Edit
objRecordset.Recordset("DueDate") = shmMonth.FocusDate
objRecordset.Recordset("Begintime") = SSDay1.X.Tasks(TaskIndex).BeginTime
objRecordset.Recordset("Endtime") = SSDay1.X.Tasks(TaskIndex).EndTime
objRecordset.Recordset("EventName") = SSDay1.X.Tasks(TaskIndex).Text
objRecordset.Recordset.Update
End If

Call MarkEventsOnMonthCalendar(shmMonth.FocusDate)

shmMonth.SelectedDays.Add shmMonth.FocusDate

shmMonth.Enabled = True
End If

End Sub

Private Sub SSDay1_DeleteTask(RtnCancel As Integer, RtnDispPromptMsg As Integer)
    Call Command1_Click
End Sub

Private Sub shmMonth_SelChange(SelDate As String, OldSelDate As String, Selected As Integer, RtnCancel As Integer)

    SSDay1.X.Tasks.RemoveAll

    objRecordset.RecordSource = "Select * from tblEventArchive where DueDate = #" & SelDate & "#"
   
    objRecordset.Refresh

    If objRecordset.Recordset.RecordCount > 0 Then
            'If objRecordset.Recordset.Count Then
             
              objRecordset.Recordset.MoveFirst
          Do While Not objRecordset.Recordset.EOF
            SSDay1.X.Tasks.Add objRecordset.Recordset("BeginTime"), objRecordset.Recordset("EndTime"), objRecordset.Recordset("EventName")
                       
            objRecordset.Recordset.MoveNext
        Loop
    End If
 

End Sub

---