0
votes

I want to add an appointment to a shared Outlook calendar. I know how to add to other people's calendars from MS Access, but I'm having trouble with shared calendars. The creator of the calendar also has their own personal calendar. All of my previous attempts have just added to their personal calendar.

Here's my code... I've tried gathering code on various websites and I'm just stuck. I appreciate any help.

Private Sub Add_to_Shared_Calendar_Click()
Dim outMail As Outlook.AppointmentItem
Dim objNS As Outlook.NameSpace
Dim objFolder As Outlook.MAPIFolder 'get name of other persons folder
Dim objRecip As Outlook.Recipient 'other persons name
Dim strName As String 'the name or email of the persons folder
Dim objAppt As Outlook.AppointmentItem
Dim objApp As Outlook.Application
On Error Resume Next
' name of person whose Calendar you want to use - right?
strName = "John Smith - Project Name Shared Calendar"
Set objNS = objApp.GetNamespace("MAPI")
Set objRecip = objNS.CreateRecipient(strName)
Set objFolder = objNS.GetSharedDefaultFolder(objRecip, olFolderCalendar)
Set outMail = Outlook.CreateItem(olAppointmentItem)
outMail.Subject = "test"
outMail.Location = ""
outMail.MeetingStatus = olMeeting
outMail.Start = Me.dateofevent
outMail.End = Me.TimeofEvent
outMail.RequiredAttendees = strName
outMail.Body = "test message"
outMail.Send
Set outMail = Nothing
End Sub
1
You will save years of your life by learning how to use On Error Resume Next if you plan to use it again.niton

1 Answers

1
votes

Replace the lines

 outMail = Outlook.CreateItem(olAppointmentItem)
 ... 
 outMail.Send

with

 outMail = objFolder.Items.Add
 ...
 outMail.Save