Exporting Excel data to Outlook 2016 Calendar

[Ron Legg]

Hi

I'm building up some VBA based on Diane's examples in
http://www.slipstick.com/developer/create-appointments-spreadsheet-data/ and making good progress. I'm using Excel 2016 and Outlook 2016.

Diane's export VBA from Excel to Outlook works fine with a newly created local calendar under 'My Calendars' and I believe this code identifies the default calendar:
Set CalFolder = olNs.GetDefaultFolder(olFolderCalendar)

I now need to export my Excel data to a Shared Calendar which I have added from the Address Book into my new shared calendar located in 'Other Calendars' and require the 'Set CalFolder' code to identify this.

When I try to run without this reference to the correct shared calendar I get this error:

Microsoft Visual Basic

Run-time error '-2147221233 (8004010f)';
The attempted operation failed. An object could not be found.

and in debug it highlights this line of code:
Set subFolder = CalFolder.Folders(arrCal)

There must be a way of referencing the shared calendar I have added to 'Other Calendars' from the Address Book and any help is much appreciated.

Thanks

 

[Diane Poremsky]

You will need to change Set CalFolder to use the shared calendar - see Working with VBA and non-default Outlook Folders for the method.

 

[Diane Poremsky]

Oh... and this

Run-time error '-2147221233 (8004010f)';
The attempted operation failed. An object could not be found.

and in debug it highlights this line of code:
Set subFolder = CalFolder.Folders(arrCal)

is only needed if you are importing into multiple subfolders of your calendar. To import into one calendar, remove that line and change
Set olAppt = subFolder.Items.Add(olAppointmentItem)
to
Set olAppt = calFolder.Items.Add(olAppointmentItem)


Or just use the second macro at Create Appointments Using Spreadsheet Data

Set CalFolder = olNs.GetDefaultFolder(olFolderCalendar) <== this needs changed to reference the shared calendar
i = 2
Do Until Trim(Cells(i, 1).Value) = ""
Set olAppt = CalFolder.Items.Add(olAppointmentItem)

 

[Ron Legg]

Hi Diane

Thanks very much for getting back to me. I've tried all the suggested ways of connecting to my shared calendar and am currently using the second macro at Create Appointments Using Spreadsheet Data however I'm getting the 'An object could not be found' error when using:

Set Items = Session.GetDefaultFolder(olFolderCalendar).Folders("My Shared Calendar name").Items
Set Items = Session.GetDefaultFolder(olFolderCalendar).Parent.Folders("My Shared Calendar name").Items

When I try - Set CalFolder = olNs.GetDefaultFolder(olFolderCalendar) the macro works but it populates my personal calendar and not the shared calendar.

The shared calendar was set up by our ICT support and I added it from the Address Book. It is located in the same folder as my own personal calendar and the calendar group in named "My Calendars". I've also tried this in other calendar group folders in my profile without success.

Any more ideas please?

Thanks very much.

 

[Diane Poremsky]

When I try - Set CalFolder = olNs.GetDefaultFolder(olFolderCalendar) the macro works but it populates my personal calendar and not the shared calendar.

That is correct as it references your default calendar.

The shared calendar was set up by our ICT support and I added it from the Address Book. It is located in the same folder as my own personal calendar and the calendar group in named "My Calendars". I've also tried this in other calendar group folders in my profile without success.

if it's a calendar in another mailbox, you need to use the method here - Working with VBA and non-default Outlook Folders and get the calendar's mailbox.

--snip--
Set objOwner = NS.CreateRecipient("shared-alias")
   objOwner.Resolve
-- snip --
Set newCalFolder = NS.GetSharedDefaultFolder(objOwner, olFolderCalendar)

 

[Ron Legg]

Hi Diane

I tried the new code and received this error:

This is the revised code in my latest attempt:

Public Sub CreateOutlookAppointments()
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 Items As Outlook.Items

Dim NS As Outlook.Namespace
Dim objOwner As Outlook.Recipient

Dim newCalFolder As Outlook.MAPIFolder

Dim i As Long


Set NS = Application.GetNamespace("MAPI")
Set objOwner = NS.CreateRecipient("My shared calendar")
objOwner.Resolve

If objOwner.Resolved Then
'MsgBox objOwner.Name
Set newCalFolder = NS.GetSharedDefaultFolder(objOwner, olFolderCalendar)
End If



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

i = 2
Do Until Trim(Cells(i, 1).Value) = ""

Set olAppt = newCalFolder.Items.Add(olAppointmentItem)

With olAppt


'Define calendar item properties

.Start = Cells(i, 6) '+ Cells(i, 7) '+ TimeValue("9:00:00")
.End = Cells(i, 7) '+ Cells(i, 9) '+TimeValue("10:00:00")
.Subject = Cells(i, 2)
.Location = Cells(i, 3)
.Body = Cells(i, 4) + Chr(13) + Cells(i, 9)
.BusyStatus = olBusy
'.ReminderMinutesBeforeStart = Cells(i, 10)
.ReminderSet = False
.Categories = Cells(i, 5)
.RequiredAttendees = Cells(i, 11)
'.Importance = Cells(i, 12)
.Save

End With


i = i + 1
Loop
Set olAppt = Nothing
Set olApp = Nothing

Exit Sub

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

End Sub

 

[Diane Poremsky]

in the VBA editor, did you set a reference to the Microsoft outlook object model under tools, references?

 

[Ron Legg]

Hi

Yes, I did it right at the beginning of this project

 

[Diane Poremsky]

Try moving this
Set NS = Application.GetNamespace("MAPI")
Set objOwner = NS.CreateRecipient("My shared calendar")
objOwner.Resolve

If objOwner.Resolved Then
'MsgBox objOwner.Name
Set newCalFolder = NS.GetSharedDefaultFolder(objOwner, olFolderCalendar)
End If

to after you set the application and change the NS line

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

Set NS = olApp.GetNamespace("MAPI")
Set objOwner = NS.CreateRecipient("My shared calendar")
objOwner.Resolve

If objOwner.Resolved Then
'MsgBox objOwner.Name
Set newCalFolder = NS.GetSharedDefaultFolder(objOwner, olFolderCalendar)
End If

 

[Ron Legg]

Hi

Changed as suggested - getting closer I think.
Just getting this now:

Latest code

Public Sub CreateOutlookAppointments()
Sheets("Sheet1").Select

On Error GoTo Err_Execute

Dim olApp As Outlook.Application
Dim olAppt As Outlook.AppointmentItem
Dim blnCreated As Boolean
Dim NS As Outlook.Namespace
Dim objOwner As Outlook.Recipient
Dim newCalFolder As Outlook.MAPIFolder
Dim Items As Outlook.Items
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

Set NS = olApp.GetNamespace("MAPI")
Set objOwner = NS.CreateRecipient("My shared calendar")
objOwner.Resolve

If objOwner.Resolved Then
MsgBox objOwner.Name
Set newCalFolder = NS.GetSharedDefaultFolder(objOwner, olFolderCalendar)
End If


On Error GoTo 0

i = 2
Do Until Trim(Cells(i, 1).Value) = ""

Set olAppt = newCalFolder.Items.Add(olAppointmentItem)

With olAppt



'Define calendar item properties

.Start = Cells(i, 6) '+ Cells(i, 7) '+ TimeValue("9:00:00")
.End = Cells(i, 7) '+ Cells(i, 9) '+TimeValue("10:00:00")
.Subject = Cells(i, 2)
.Location = Cells(i, 3)
.Body = Cells(i, 4) + Chr(13) + Cells(i, 9)
.BusyStatus = olBusy
'.ReminderMinutesBeforeStart = Cells(i, 10)
.ReminderSet = False
.Categories = Cells(i, 5)
.RequiredAttendees = Cells(i, 11)
'.Importance = Cells(i, 12)
.Save

End With
Cells(i, 10) = "Exported"

i = i + 1
Loop
Set olAppt = Nothing
Set olApp = Nothing

Exit Sub

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

End Sub

 

[Diane Poremsky]

Did the correct mailbox name come up when you set the owner?
MsgBox objOwner.Name

if a message box didn't come up then the name wasn't resolved.

Try adding a msgbox to let you know if it failed:

If objOwner.Resolved Then
MsgBox objOwner.Name
Set newCalFolder = NS.GetSharedDefaultFolder(objOwner, olFolderCalendar)
else
msgbox "Failed!"
End If

I'm guessing it will fail.

 

[Ron Legg]

Hi Diane

Yes your prediction is correct, it did fail and didn't resolve and therefore I'm thinking that maybe it's the way our ICT support set up the shared calendar. It looks like the code would work but the calendar is in some way badly configured. Are there any rules we need to be aware of when setting these up?

thanks.

 

[Diane Poremsky]

None of the lines are red are they?

 

[Diane Poremsky]

i think object names are not matching up -
Dim olApp As Outlook.Application
Dim olAppt As Outlook.AppointmentItem
Dim blnCreated As Boolean
'Dim olNs As Outlook.Namespace

then the namespace is set again - Set NS = olApp.GetNamespace("MAPI")

 

[Diane Poremsky]

I'm still getting errors even after fixing the object names. I'm pretty sure its just something unique to calling outlook from excel, not anything specific to your system.

 

[Diane Poremsky]

This is working for me - i created the resources in a test tenant earlier today and had to force the address book to sync before it would resolve objowner but it's working now.

Option Explicit
Public Sub CreateOutlookAppointments()
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 objOwner As Outlook.Recipient

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 objOwner = olNs.CreateRecipient("blue")
objOwner.Resolve

If objOwner.Resolved Then
'MsgBox objOwner.Name
Set CalFolder = olNs.GetSharedDefaultFolder(objOwner, olFolderCalendar)
Else
Exit Sub
End If

i = 2
Do Until Trim(Cells(i, 1).Value) = ""

Set olAppt = CalFolder.Items.Add(olAppointmentItem)

With olAppt

'Define calendar item properties
.Start = Cells(i, 5) + Cells(i, 6) '+ TimeValue("9:00:00")
.End = Cells(i, 7) + Cells(i, 8) '+TimeValue("10:00:00")
.Subject = Cells(i, 1)
.Location = Cells(i, 2)
.Body = Cells(i, 3)
.BusyStatus = olBusy
.ReminderMinutesBeforeStart = Cells(i, 9)
.ReminderSet = True
.Categories = Cells(i, 4)
.Save
' For meetings or Group Calendars
' .Send
End With

i = i + 1
Loop
Set olAppt = Nothing
Set olApp = Nothing

Exit Sub

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

End Sub

 

[Ron Legg]

Many thanks Diane

There were no red entries and I will ask my ICT guys to sync my address book as the code should now work following this.

 

[Diane Poremsky]

You should be able to do it yourself - go to Send & Receive tab then Send and Receive Groups, Download Offline Address book. That is how i fixed it at least.

 

[Ron Legg]

Hi, I followed that advice and downloaded the address book via the Send/Receive Groups option.

The VBA doesn't return any errors now however the message box indicates that the shared calendar from the address book still isn't resolved. I may be wrong but this issue could be the way that the shared calendar has been set up or maybe a permissions issue. I can certainly add diary entries manually within outlook however the VBA won't populate the diary from Excel. That being said, the original VBA does work on locally created calendars.

 

[Diane Poremsky]

Resolving doesn't require permissions. Adding to the calendar does.

The only thing that would affect resolving (besides the entry not synced to the offline gal) is if it is visible. If its hidden, it won't resolve (and won't be in the offline gal).

How the calendar is added to outlook won't affect this code - it works with both mailboxes and shared folders.

Try using the default smtp address in this line
Set objOwner = olNs.CreateRecipient("blue")

I use the alias, but it should work with the display name too.