This seems to be a very hard subject to find any information on and when you do find any, it all points to using the builtin renderer, which is OK but no much good if your after a specific look and feel. There are a few points I'd like to make before we get started with the code which will hopefully help you setting this up.
1. If your webserver is seperate from your Exchange server then you'll need to install OWA (Outlook Web Access) on the webserver so that you have the required libraries installed (cdo.dll, etc)
2. From what you've said in your post I'm not sure if your setting this up to use one calendar accessable by all or each user using their own calendar. If your IIS is setup to use Windows (NT) authentication then the user that logs in will only have access to their own mailbox unless you sepcifically give them permissions to access other mailboxes. If you wish to use Anonymous Authentication in IIS then you'll have to create a domain account, e.g. IUSR_WEBEXCHANGE, use this for IIS anonymous access, create a mailbox for this account and give this account permission to open any mailboxes that it requires access to.
If the users are going to be accessing the same calendar then the easiest way is just to use the mailbox for the IUSR_WEBEXCHANGE.
3. The code I created has only been tested on a Windows 2000 (IIS 5) and Exchange 5.5/2000 but I can't imagine their being any difficulties.
Some of the code is commented but I don't have time at the moment to go through and fully document it all. It's also been trimmed down slightly to remove references to anything particular to my setup/site.
CODE
-------------------------------------------
<% Function GetDaysInMonth(iMonth, iYear)
Dim dTemp
dTemp = DateAdd("d", -1, DateSerial(iYear, iMonth + 1, 1))
GetDaysInMonth = Day(dTemp)
End Function
Function GetWeekdayMonthStartsOn(dAnyDayInTheMonth, intWeekdayStart)
Dim dTemp
dTemp = DateAdd("d", -(Day(dAnyDayInTheMonth) - 1), dAnyDayInTheMonth)
GetWeekdayMonthStartsOn = WeekDay(dTemp, intWeekdayStart)
End Function
Function SubtractOneMonth(dDate)
SubtractOneMonth = DateAdd("m", -1, dDate)
End Function
Function AddOneMonth(dDate)
AddOneMonth = DateAdd("m", 1, dDate)
End Function
Dim dDate ' Date we're displaying calendar for
Dim iDIM ' Days In Month
Dim iDOW ' Day Of Week that month starts on
Dim iCurrent ' Variable we use to hold current day of month as we write table
Dim iPosition ' Variable we use to hold current position in table
Dim dCurrentDate
Dim arrAppointmentDetails
Dim intCounter
Dim dteStartDate
Dim dteEndDate
Dim arrAppointment
Dim blnAppointmentsFound
Dim strModuleTitle
Const CdoDefaultFolderCalendar = 0
Const CdoPR_START_DATE = &H00600040
Const CdoPR_END_DATE = &H00610040
Dim strServer
Dim strMailbox
Dim strProfileInfo
Dim objSession
Dim objCalendarFolder
Dim objAppointment
Dim objMessages
Dim objFilter
On Error Resume Next
strServer = "exchange" 'the name of your Exchange server
strMailbox = "IUSR_WEBEXCHANGE" 'the exchange mailbox account you wish to open
strModuleTitle = "Calendar" 'this is just the title that's displayed at the top of the calendar module
strURL = "http://www.yourwebsite.com/calendar.asp?calshow=" & Request.QueryString("calshow") & "&date="
' Get selected date. There are two ways to do this.
' First check if we were passed a full date in the querystring.
' If so use it, if not use today.
If IsDate(Request.QueryString("calshow")) Then
dDate = CDate(Request.QueryString("calshow"))
Else
If IsDate(Request.QueryString("day") & "/" & Request.QueryString("month") & "/" & Request.QueryString("year")) Then
dDate = CDate(Request.QueryString("day") & "/" & Request.QueryString("month") & "/" & Request.QueryString("year"))
Else
dDate = Date()
End If
End If
dteStartDate = "01/" & Month(dDate) & "/" & Year(dDate)
dteStartDate = CDate(dteStartDate)
dteEndDate = GetDaysInMonth(Month(dDate), Year(dDate)) & "/" & Month(dDate) & "/" & Year(dDate)
dteEndDate = CDate(dteEndDate)
blnAppointmentsFound = False
strProfileInfo = strServer & vbLf & strMailbox
Set objSession = Server.CreateObject("MAPI.Session")
objSession.Logon , , False, True, 0, True, strProfileInfo
'get the calendar for the users mailbox
Set objCalendarFolder = objSession.GetDefaultFolder(CdoDefaultFolderCalend ar)
Set objMessages = objCalendarFolder.Messages
'get the appointments for the current month
Set objFilter = objMessages.Filter
objFilter.Fields.Add CdoPR_END_DATE, dteStartDate
objFilter.Fields.Add CdoPR_START_DATE, dteEndDate
ReDim arrAppointmentDetails(150, 2) 'set the size of the array to hold the appointments
intCounter = 0
For Each objAppointment In objMessages
intCounter = intCounter + 1
arrAppointmentDetails(intCounter, 1) = objAppointment.ID
arrAppointmentDetails(intCounter, 2) = FormatDateTime(objAppointment.StartTime, vbShortDate)
Next
objSession.Logoff
'Now we've got the date. Now get Days in the choosen month and the day of the week it starts on.
iDIM = GetDaysInMonth(Month(dDate), Year(dDate))
iDOW = GetWeekdayMonthStartsOn(dDate, CInt(Session("week_starts_on")))
Response.Write "<table width=""100%"">" & vbCrLf
Response.Write "<tr>" & vbCrLf
Response.Write "<td>" & strModuleTitle & "</td>" & vbCrLf
Response.Write "</tr>" & vbCrLf
Response.Write "</table>" & vbCrLf
'there was an error whilst trying to run the calendar module
If Err.Number <> 0 Then
Response.Write "<table width=""100%"" cellpadding=""0"" cellspacing=""0"">" & vbCrLf
Response.Write "<tr>" & vbCrLf
Response.Write "<td>Unable to retrieve any events information.</td>" & vbCrLf
Response.Write "</tr>" & vbCrLf
Response.Write "</table>" & vbCrLf
Else
Response.Write "<table width=""100%"" cellpadding=""0"" cellspacing=""0"">" & vbCrLf
Response.Write "<tr>" & vbCrLf
Response.Write "<td><a href=""?calshow=" & SubtractOneMonth(dDate) & "&date=" & Request.QueryString("date") & """ title=""" & MonthName(Month(SubtractOneMonth(dDate))) & " " & Year(SubtractOneMonth(dDate)) & """><img src=""/assets/images/calendar_prev.gif"" width=""11"" height=""11"" alt=""" & MonthName(Month(SubtractOneMonth(dDate))) & " " & Year(SubtractOneMonth(dDate)) & """></a></td>" & vbCrLf
Response.Write "<td colspan=""5""><strong>" & MonthName(Month(dDate)) & " " & Year(dDate) & "</strong></td>" & vbCrLf
Response.Write "<td><a href=""?calshow=" & AddOneMonth(dDate) & "&date=" & Request.QueryString("date") & """ title=""" & MonthName(Month(AddOneMonth(dDate))) & " " & Year(AddOneMonth(dDate)) & """><img src=""/assets/images/calendar_next.gif"" width=""11"" height=""11"" alt=""" & MonthName(Month(AddOneMonth(dDate))) & " " & Year(AddOneMonth(dDate)) & """></a></td>" & vbCrLf
Response.Write "</tr>" & vbCrLf
Response.Write "<tr>" & vbCrLf
Response.Write "<td><abbr title=""Monday"">M</abbr></td>" & vbCrLf
Response.Write "<td><abbr title=""Tuesday"">T</abbr></td>" & vbCrLf
Response.Write "<td><abbr title=""Wednesday"">W</abbr></td>" & vbCrLf
Response.Write "<td><abbr title=""Thursday"">T</abbr></td>" & vbCrLf
Response.Write "<td><abbr title=""Friday"">F</abbr></td>" & vbCrLf
Response.Write "<td><abbr title=""Saturday"">S</abbr></td>" & vbCrLf
Response.Write "<td><abbr title=""Sunday"">S</abbr></td>" & vbCrLf
Response.Write "</tr>" & vbCrLf
Response.Write "<tr>" & vbCrLf
Response.Write "<td colspan=""7""></td>" & vbCrLf
Response.Write "</tr>" & vbCrLf
' Write spacer cells at beginning of first row if month doesnt start on a Sunday.
If iDOW <> 1 Then
Response.Write "<tr>" & vbCrLf
iPosition = 1
Do While iPosition < iDOW
Response.Write "<td> </td>" & vbCrLf
iPosition = iPosition + 1
Loop
End If
'Write days of month in proper day slots
iCurrent = 1
iPosition = iDOW
Do While iCurrent <= iDIM
blnAppointmentsFound = False
' If were at the beginning of a row then starte a row (<tr>)
If iPosition = 1 Then
Response.Write "<tr>" & vbCrLf
End If
dCurrentDate = CDate(iCurrent & "/" & Month(dDate) & "/" & Year(dDate))
If dCurrentDate = Date() Then 'if the day were writing is today then apply a different style to the cell
Response.Write "<td class=""calendar_td_today"">"
Else
Response.Write "<td>"
End If
'look for any appointments for this day
If IsArray(arrAppointmentDetails) Then
For intCounter = 1 To UBound(arrAppointmentDetails)
If CDate(arrAppointmentDetails(intCounter, 2)) = CDate(dCurrentDate) Then
blnAppointmentsFound = True
Exit For
End If
Next
End If
If blnAppointmentsFound = True Then
Response.Write "<a href=""" & strURL & iCurrent & Server.HTMLEncode("/") & Month(dDate) & Server.HTMLEncode("/") & Year(dDate) & """><strong>" & iCurrent & "</strong></a>" & vbCrLf
Else
Response.Write "<a href=""" & strURL & iCurrent & Server.HTMLEncode("/") & Month(dDate) & Server.HTMLEncode("/") & Year(dDate) & """>" & iCurrent & "</a>" & vbCrLf
End If
Response.Write "</td>" & vbCrLf
' If were at the end of a row then close the row (</tr>)
If iPosition = 7 Then
Response.Write "</tr>" & vbCrLf
iPosition = 0
End If
' Increment variables
iCurrent = iCurrent + 1
iPosition = iPosition + 1
Loop
' Write spacer cells at end of last row if month doesnt end on a Saturday.
If iPosition <> 1 Then
Do While iPosition <= 7
Response.Write "<td> </td>" & vbCrLf
iPosition = iPosition + 1
Loop
Response.Write "</tr>" & vbCrLf
End If
Response.Write "</td>" & vbCrLf
Response.Write "</tr>" & vbCrLf
Response.Write "</table>" & vbCrLf
End If
Set dDate = Nothing
Set iDIM = Nothing
Set iDOW = Nothing
Set iCurrent = Nothing
Set iPosition = Nothing
Set dCurrentDate = Nothing
Set strServer = Nothing
Set strMailbox = Nothing
Set strProfileInfo = Nothing
Set objSession = Nothing
Set objCalendarFolder = Nothing
Set objAppointment = Nothing
Set objMessages = Nothing
Set objFilter = Nothing
Set arrAppointmentDetails(150, 2) = Nothing
Set intCounter = Nothing
Set dteStartDate = Nothing
Set dteEndDate = Nothing
Set arrAppointment = Nothing
Set blnAppointmentsFound = Nothing
Set strURL = Nothing
Set strModuleTitle = Nothing %>
-------------------------------------------
END CODE
Newbie question : using CDO to create appointments
