Help using a Macro to send data to shared Outlook Calendars

[Neilp27]

Hello,

I am currently setting up a spreadsheet for my office in which we can enter appointments and use a macro to send them to specific calendars in microsoft exchange by selecting their name. I currently have this working and sending to calendars that I have made myself but I am stuck with how to send the data to other people. Currently, my macro looks like this:

----------------------------------------------------------------

Option Explicit
Public Sub CreateOutlookApptz()
Sheets("Sheet1").Select
On Error GoTo Err_Execute

Dim olApp As Outlook.Application
Dim olAppt As Outlook.AppointmentItem
Dim blnCreated As Boolean
Dim olNs As Outlook.Namespace
Dim CalFolder As Outlook.MAPIFolder
Dim subFolder As Outlook.MAPIFolder
Dim arrCal As String


Dim i As Long

On Error Resume Next
Set olApp = Outlook.Application

If olApp Is Nothing Then
Set olApp = Outlook.Application
blnCreated = True
Err.Clear
Else
blnCreated = False
End If

On Error GoTo 0

Set olNs = olApp.GetNamespace("MAPI")
Set CalFolder = olNs.GetDefaultFolder(olFolderCalendar)

i = 2
Do Until Trim(Cells(i, 1).Value) = ""
arrCal = Cells(i, 1).Value
Set subFolder = CalFolder.Folders(arrCal)
If Trim(Cells(i, 11).Value) = "" Then
Set olAppt = subFolder.Items.Add(olAppointmentItem)



With olAppt


.Start = Cells(i, 5)
.End = Cells(i, 12)
.Subject = Cells(i, 2)
.Location = Cells(i, 3)
.Body = Cells(i, 4)
.BusyStatus = olBusy
.ReminderMinutesBeforeStart = Cells(i, 7)
.ReminderSet = True
.Save

End With
Cells(i, 11) = "Imported"

End If

i = i + 1
Loop
Set olAppt = Nothing
Set olApp = Nothing
ThisWorkbook.Save
Exit Sub

Err_Execute:
MsgBox "An error occurred - Exporting items to Calendar."

End Sub​

----------------------------------------------------------------

In which arrCal is a dropdown field that is currently set to go to test calendars that I have made myself. Any help in this would be greatly appreciated as I have been struggling with this for most of the day. If anyone needs any further information about the spreadsheet feel free to ask.

Thanks,

Neilp27

 

[jimrward]

If you are using exchange in a work environment you will probably need active directory settings on other email accounts modified to allow you to see and set appointments for accounts not belonging to you before you even look into the coding