I need some help in modifying the ApptCalendar db that I believe orginated from UtterAccess.com that also had a few other modifications along the way. I downloaded my copy from this site and am hoping someone can help me in revising the coding so it can work as I think it can. My problem is that I would like to modify the Public Sub DisplayDailyMeetings() code [below] that updates the appointments on the Daily Calendar form the event procedure OnOPen to only update the appointments by ApptLocation (which are now the room names in my scheduler) and the Calendar View date chosen or defaulted date (today) as the code indicates. I also would like the ApptLocation box that I added on the top of Daily Calendar form to be able to be updated by ApptLocation arrow boxes if clicked (see attached form snapshots Daily Calendar form for clarity). Below is the code that populates the Daily Calendar form OnOpen. Help with this coding would be greatly appreciated. I also have a problem with the shading code on the Daily Calendar form due to the added hours from 12AM to 1AM I added, but this is a secondary problem right now. Thanks in advance for all help offered...




[IMG]file:///C:/Users/seashton/AppData/Local/Temp/moz-screenshot-3.png[/IMG]' This sub fills in the appointments on the daily calendar.

Public Sub DisplayDailyMeetings()

Dim strSQL As String
Dim i As Integer
Dim r As Integer
Dim intTemp As Integer
Dim intLength(37) As Integer
Dim strHours(37) As String
Dim strApptSubject As String
Dim strApptStartTime As String
Dim strApptEndTime As String
Dim rst

' Clear all appointments and shading
For r = 1 To 34
Me("txtShade" & Trim(r)) = ""
Me("txtShade" & Trim(r)).BackColor = 16777215
Me("txt" & Trim(r)) = ""
strHours(r) = ""
Next r

' Update the active date in the form header
Me.lblDate.Caption = Format(dtePubMyDate, "Long Date")

' Get the appointments for the active date
strSQL = "SELECT tblAppointments.*, tblHour.HourID " & _
"FROM tblAppointments INNER JOIN tblHour " & _
"ON tblAppointments.ApptStartTime = tblHour.Hours " & _
"WHERE tblAppointments.ApptDate = #" & dtePubMyDate & "# " & _
"ORDER BY ApptStartTime;"

Set rst = CurrentDb.OpenRecordset(strSQL)

' If there are appointments for the active date...
If rst.RecordCount > 0 Then

' Loop through the active date's appointments and assign
' the subject/length of appointment to the right arrays
rst.MoveFirst
Do While Not rst.EOF
strApptStartTime = rst!ApptStartTime
strApptEndTime = rst!ApptEndTime
strApptSubject = rst!Appt
intTemp = rst!HourID

' assign the subject to the array
If Not IsNull(strApptSubject) Then
strHours(intTemp) = strApptSubject

' Calculate minutes, then divide by 30 to get half hour increments
intLength(intTemp) = Abs(DateDiff("n", strApptEndTime, strApptStartTime)) / 30
End If
rst.MoveNext
Loop

' Loop through the textboxes and fill in the appointments and
' shade the times that the appointment takes up. Also, add arrows.
For r = 1 To 36

' Meeting subject
Me("txt" & Trim(r)) = strHours(r)

' If the time box is shaded or free, skip it
If (Me("txt" & Trim(r)).Value) = "" And (Me("txtShade" & Trim(r)).Value) = "" Then
Me("txtShade" & Trim(r)).BackColor = 16777215
ElseIf (Me("txt" & Trim(r)).Value) = "" And (Me("txtShade" & Trim(r)).Value) <> "" Then
' Do nothing
Else
' Shade in the time slots and put in the arrow markers (Symbol font)
Me("txtShade" & Trim(r)).BackColor = 16764057
' Up Arrow (beginning of meeting)
Me("txtShade" & Trim(r)).Value = Chr(173)

For i = 1 To (intLength(r) - 2)
Me("txtShade" & Trim(r + i)).BackColor = 16764057
' Vertical line (Middle of long meeting)
Me("txtShade" & Trim(r + i)).Value = Chr(189)
Next i

Me("txtShade" & Trim(r + intLength(r) - 1)).BackColor = 16764057
' Down Arrow (End of meeting)
Me("txtShade" & Trim(r + intLength(r) - 1)).Value = Chr(175)
End If
Next r
End If

rst.Close

End Sub