Adding Appointments from Excel Spreadsheet to Outlook Calendar

[Bwiles96]

I am needing assistance in implementing a code into my existing code to not add already scheduled appointments to the calendar. Basically I will be running this everyday, and everyday a new entry is added to the excel document. However, the code I have now will add appointments that were already added the previous days. I am looking for a way to not duplicate appointments.

ALSO! I am needing to find a way to make this code add the appointments to a SHARED calendar. Right now it only adds to my personal one. Any and all help is so very much appreciated.

Code:

Sub Appointments()

Dim OL As Outlook.Application, Appoint As Outlook.AppointmentItem, ES As Worksheet, _
r As Long, i As Long, WB As ThisWorkbook

Set WB = ThisWorkbook
Set ES = WB.Sheets("Sheet1")
r = ES.Cells(Rows.Count, 1).End(xlUp).Row
Set OL = New Outlook.Application

For i = 2 To r
If ES.Cells(i, 15) = "Bulk" Then
Set Appoint = OL.CreateItem(olAppointmentItem)
With Appoint
.Subject = ES.Cells(i, 13).Value
.Start = ES.Cells(i, 4).Value
.Duration = 60
.AllDayEvent = False
.Categories = ES.Cells(i, 16).Value & " Category"
.Body = ES.Cells(i, 12).Value
.Save
End With
End If
Next i
Set OL = Nothing

End Sub


I have not had a starting place on my request, so all help is appreciated.