Create Outlook 2013 Calendar items without duplicates

[Arogance1]

Good morning / afternoon,
I'm trying to create a macro that will allow me to add calendar items to an Outlook 2013 calendar, but if it already exists, to ignore it.
Basically, I want to have a list of important dates, and if I add to it at a later date, people can click a button to add all the ones they don't already have

The code I currently have is :

Sub AddAppointments()
    ' Create the Outlook session
    Set myOutlook = CreateObject("Outlook.Application")
    ' Start at row 2
    r = 2
    Do Until Trim(Cells(r, 1).Value) = ""
        ' Create the AppointmentItem
        Set myApt = myOutlook.createitem(1)
        ' Set the appointment properties
        myApt.Subject = Cells(r, 1).Value
        myApt.Location = Cells(r, 2).Value
        myApt.Start = Cells(r, 3).Value
        myApt.Duration = Cells(r, 4).Value
        ' If Busy Status is not specified, default to 2 (Busy)
        If Trim(Cells(r, 5).Value) = "" Then
            myApt.BusyStatus = 2
        Else
            myApt.BusyStatus = Cells(r, 5).Value
        End If
        If Cells(r, 6).Value > 0 Then
            myApt.ReminderSet = True
            myApt.ReminderMinutesBeforeStart = Cells(r, 6).Value
        Else
            myApt.ReminderSet = False
        End If
        myApt.Body = Cells(r, 7).Value
        myApt.Save
        r = r + 1
    Loop
End Sub

[Paul_Hossler]

Might be better to post this in the Outlook forum or ask one of the mods to move it for you

[Arogance1]

Might be better to post this in the Outlook forum or ask one of the mods to move it for you

But I need the macro in Excel, not Outlook

[Paul_Hossler]

Sorry - misunderstood. Should have read it more carefully

[snb]

To make a start:

Sub M_snb()
    sn = ActiveSheet.Columns(1).CurrentRegion

    With CreateObject("Outlook.Application")
        For j = 2 To UBound(sn)
            c00 = "[Start] ='" & Format(sn(j, 3), "ddddd h:mm") & "' And [Subject]='" & sn(j, 1) & "'"
            If .GetNamespace("MAPI").GetDefaultFolder(9).Items.Find(c00).Start = "" Then
        
            With .createitem(1)
                 .Subject = sn(j, 1)
                .Location = sn(j, 2)
                .Start = sn(j, 3)
                .Duration = sn(j, 4)
                .BusyStatus = 2
                If sn(j, 5) <> "" Then .BusyStatus = sn(j, 5)
                .ReminderSet = False
                If sn(j, 6) > 0 Then
                    .ReminderSet = True
                    .ReminderMinutesBeforeStart = sn(j, 6)
                End If
                .Body = sn(j, 7)
                .Save
            End With
            End If
        Next
    End With
End Sub

You can find more over here: http://www.snb-vba.eu/VBA_Outlook_external_en.html#L6

[Arogance1]

When I use the code above, I get an error:

Run-time error '91':
Object variable or With block variable not set

When I click Debug, the line highlighted is
If .GetNamespace("MAPI").GetDefaultFolder(9).Items.Find(c00).Start = "" Then

I have the Microsoft Outlook 15.0 Object Library enabled.

[snb]

Makes sense:

Sub M_snb() 
    on error resume next
    sn = ActiveSheet.Columns(1).CurrentRegion 
     
    With CreateObject("Outlook.Application") 
        For j = 2 To UBound(sn) 
            c00 = "[Start] ='" & Format(sn(j, 3), "ddddd h:mm") & "' And [Subject]='" & sn(j, 1) & "'" 
            c01=.GetNamespace("MAPI").GetDefaultFolder(9).Items.Find(c00).Start
            if err.number<>0 then 
                With .createitem(1) 
                    .Subject = sn(j, 1) 
                    .Location = sn(j, 2) 
                    .Start = sn(j, 3) 
                    .Duration = sn(j, 4) 
                    .BusyStatus = 2 
                    If sn(j, 5) <> "" Then .BusyStatus = sn(j, 5) 
                    .ReminderSet = False 
                    If sn(j, 6) > 0 Then 
                        .ReminderSet = True 
                        .ReminderMinutesBeforeStart = sn(j, 6) 
                    End If 
                    .Body = sn(j, 7) 
                    .Save 
                End With 
                err.clear
            End If 
        Next 
    End With 
End Sub

[Arogance1]

That's excellent, thank you