This is a snip of code from my InitCalendar function. I
am trying to add the resources to the calendar for my multiple
schedules so both schedules show up (red code), but in addition I am
also trying to add the schedules to the Calendar Schedules so the
built-in dialogs contain the schedules for selection (Blue Code)
As the code is shown below, the events show up
under the correct schedule, but the schedules do no appear in the
edit/add dialogs. if I remove the red code, obviously the events do not
display properly, but the schedules ARE listed in the dialogs.
A) What am I missing?
B) How do I make the dialog Schedule IDs (blue code) match the ID I've assigned them in the red code?
Private Sub InitCalendar()
Set R = OpenRS("Select * From CalendarSchedules order by ScheduleName")
Dim objResources As CalendarResources
Set objResources = New CalendarResources
Dim objResource As CalendarResource
Do While Not R.EOF
Set objResource = New CalendarResource
objResource.Name = R!ScheduleName
objResource.SetDataProvider2 "memory", False
objResource.DataProvider.Create
objResource.ScheduleIDs.Add R!Id
objResources.Add objResource
Dim B As Boolean
B = Calendar1.DataProvider.Schedules.AddNewSchedule(R!ScheduleName)
R.MoveNext
Loop
R.Close
Calendar1.SetMultipleResources objResources
PopulateCalendar
End Sub
Sub PopulateCalendar()
Dim R As Recordset
Dim NewEvent As CalendarEvent
Dim UserIncluded As Boolean
Calendar1.DataProvider.RemoveAllEvents
Set R = OpenRS("Select * From CalendarEvents Where Endtime>='" & DateAdd("d", -60, Date) & "'")
Do While Not R.EOF
Set NewEvent = Calendar1.DataProvider.CreateEventEx(R!EventID)
NewEvent.StartTime = R!StartTime
NewEvent.EndTime = R!EndTime
NewEvent.body = CheckForNulls(R!body)
NewEvent.location = CheckForNulls(R!location)
NewEvent.Subject = R!EventTitle
NewEvent.AllDayEvent = (R!AllDay = "Y")
NewEvent.PrivateFlag = (R!Private = "Y")
NewEvent.MeetingFlag = (R!meeting = "Y")
NewEvent.Reminder = (R!Reminder = "Y")
NewEvent.ReminderMinutesBeforeStart = R!Remindermin
NewEvent.BusyStatus = val(CheckForNulls(R!ShowTimeAs))
NewEvent.ScheduleID = R!ScheduleID
NewEvent.Categories.LoadFromString R!Categories
Calendar1.DataProvider.AddEvent NewEvent
R.MoveNext
Loop
Calendar1.Populate
CalendarEventAddedFromDB = False
End Sub
-------------
Product: Xtreme SuitePro (ActiveX) 12.0.1
Platform: Windows Vista/XP
Language: Visual Basic 6.0 SP6
|