Public Function CreateAppointment(strSubject As String, strBody As String, dtStartTime As Date, dtEndTime As
Date, bolAllDay As Boolean, Optional strAttendees As String)
Dim OlApp As New Outlook.Application, mySafeRecipient As safeRecipient, appt As Object, MyFolder As Object,
safeAppt As Object, olNs As Outlook.NameSpace
Set OlApp = CreateObject("Outlook.Application")
Set olNs = OlApp.GetNamespace("MAPI")
olNs.Logon
Dim oUtils As Object
Set oUtils = CreateObject("Redemption.MAPIUtils")
Dim myRecipient As Outlook.Recipient
Set myRecipient = olNs.CreateRecipient("C & T CALENDAR")
Set MyFolder = OlApp.Session.GetSharedDefaultFolder(myRecipient, olFolderCalendar)
If MyFolder Is Nothing Then
MsgBox ("Could not open C & T Calendar")
Exit Function
End If
'**************************************************************************************
Set safeAppt = CreateObject("Redemption.SafeAppointmentItem")
Set appt = MyFolder.Items.Add
With appt
.Subject = strSubject
.Start = dtStartTime
.End = dtEndTime
.AllDayEvent = bolAllDay
.Body = strBody
If Len(strAttendees) > 0 Then
.RequiredAttendees = strAttendees
.MeetingStatus = olMeeting
End If
.Importance = olImportanceHigh
.ReminderSet = True
.ReminderMinutesBeforeStart = 30
.Save
End With
If Len(strAttendees) > 0 Then
safeAppt.Item = appt
safeAppt.Recipients.Add (strAttendees)
If safeAppt.Recipients.ResolveAll Then
safeAppt.Send
End If
End If
Set appt = Nothing
Set MyFolder = Nothing
Set myRecipient = Nothing
Set olNs = Nothing
Set oUtils = Nothing
Set safeAppt = Nothing
Set OlApp = Nothing
Errexit:
If Err 0 Then
Debug.Print Err, Err.Description
Stop
End If
End Function
