I am having problems with duplicate message ids in my Office Calendar. I
have installed Tom Howe's Office Calendar at several client locations
without any problems. This client installation is having an odd issue when a
calendar item is saved to the Office Calendar the message id
(urn:schemas:mailheader:message-id) is the same for all saved office
calendar items. Has anyone seen this behavior? Below is the code in the
ProcessCalendar module.

Exchange 2003 SP2, Windows Server 2003 SP1


Public Sub AddItem(bstrURLItem As String)

Dim objPersonalAppointment As New CDO.Appointment
Dim objOfficeAppointment As New CDO.Appointment
Dim objRecurrence As IRecurrencePattern
Dim strOfficeCalendarURL As String
Dim strInitials As String

' Get the first three characters of the users name to put
' in front of the items added to the Office Calendar. The users
' name is the mailbox name, not the profile name.
strInitials = GetInitials(bstrURLItem)

' Reference the new Appointment added to the Personal Calendar.
objPersonalAppointment.DataSource.Open bstrURLItem



' Do not add Holidays to Office Calendar. Outlook adds holidays to
personal
' calendars and these should not all be replicated to the Office
Calendar.
' With 200 users, there would be 200 Christmas entries on December 25.
If objPersonalAppointment.Keywords(0) = "Holiday" Then

' This is a holiday, do not add it.

Else

' If the user chose to save the item to the Office Calendar, the
' BusyStatus was set to "Busy" olBusy(2) or "Out Of Office"
olBusy(3).
' If so, create an item on the Office Calendar.
If objPersonalAppointment.BusyStatus = "BUSY" Or
objPersonalAppointment.BusyStatus = "OOF" Then

' Build a string to the Office Calendar.
strOfficeCalendarURL = GetExchangeURLDomainString & "Public
Folders/Office Calendar/"

MsgBox "Current ID + " +
objPersonalAppointment.Fields("urn:schemas:mailheader:message-id") + " form
id = " + bstrURLItem

With objOfficeAppointment


' Save the Message ID in the Office Calendar Appointment.
.Fields("urn:schemas:mailheader:message-id") =
objPersonalAppointment.Fields("urn:schemas:mailheader:message-id")
.Fields.Update

' Put the values in the new Appointment item for the Office
Calendar.
.AllDayEvent = objPersonalAppointment.AllDayEvent
.BusyStatus = objPersonalAppointment.BusyStatus
.Contact = objPersonalAppointment.Contact
.ContactURL = objPersonalAppointment.ContactURL
.EndTime = objPersonalAppointment.EndTime
.Keywords = objPersonalAppointment.Keywords
.MeetingStatus = objPersonalAppointment.MeetingStatus
.Priority = objPersonalAppointment.Priority
.Resources = objPersonalAppointment.Resources
.ResponseText = objPersonalAppointment.ResponseText
.Sensitivity = objPersonalAppointment.Sensitivity
.StartTime = objPersonalAppointment.StartTime

' Check for Recurring Appointments
If objPersonalAppointment.RecurrencePatterns.Count 0 Then

Set objRecurrence = .RecurrencePatterns.Add("Add")

' If the Appointment is Recurring then put values in the
Office Calendar.
With objRecurrence

.Frequency =
objPersonalAppointment.GetRecurringMaster.RecurrencePatterns(1).Frequency
.Instances =
objPersonalAppointment.GetRecurringMaster.RecurrencePatterns(1).Instances
.Interval =
objPersonalAppointment.GetRecurringMaster.RecurrencePatterns(1).Interval
.PatternEndDate =
objPersonalAppointment.GetRecurringMaster.RecurrencePatterns(1).PatternEndDa
te

If
objPersonalAppointment.GetRecurringMaster.RecurrencePatterns(1).WeekDays.Cou
nt > 0 Then
.WeekDays.Add
objPersonalAppointment.GetRecurringMaster.RecurrencePatterns(1).WeekDays.Ite
m(1)
End If

End With

End If


' If the Appointment is marked as "Private" change the
subject and
' body of the appointment to "Private."
If .Sensitivity = 2 Then
.Location = "Private"
.LocationURL = vbNullString
.Subject = strInitials & "Private"
.TextBody = "Private"
Else
.Location = objPersonalAppointment.Location
.LocationURL = objPersonalAppointment.LocationURL
.Subject = strInitials & objPersonalAppointment.Subject
.TextBody = objPersonalAppointment.TextBody
End If

.Transparent = objPersonalAppointment.Transparent


' Does not include the collection of attachments since
Office Calendar
' is used to reference scheduled information only.

' Save the new Appointment to the Office Calendar.
.DataSource.SaveToContainer strOfficeCalendarURL

End With

End If

End If

' Destroy the object variables.
Set objPersonalAppointment = Nothing
Set objRecurrence = Nothing
Set objOfficeAppointment = Nothing

End Sub

Archived from group: microsoft>public>exchange2000>development