PDA

View Full Version : [SOLVED] Create Outlook 2013 Calendar items without duplicates



Arogance1
01-20-2016, 04:27 AM
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
01-20-2016, 07:31 AM
Might be better to post this in the Outlook forum or ask one of the mods to move it for you

Arogance1
01-20-2016, 07:59 AM
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
01-20-2016, 08:25 AM
Sorry - misunderstood. Should have read it more carefully

snb
01-20-2016, 10:27 AM
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
01-21-2016, 01:27 AM
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
01-21-2016, 02:41 AM
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
01-22-2016, 01:04 AM
That's excellent, thank you