Exporting Excel data to Outlook 2016 Calendar

Ron Legg

New Member
Outlook version
Outlook 2016 64 bit
Email Account
Exchange Server
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
 

Attachments

Diane Poremsky

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
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

New Member
Outlook version
Outlook 2016 64 bit
Email Account
Exchange Server
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

upload_2016-8-2_15-18-38.png


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

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
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.

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

Ron Legg

New Member
Outlook version
Outlook 2016 64 bit
Email Account
Exchange Server
Hi Diane

I tried the new code and received this error:

upload_2016-8-2_21-51-36.png


upload_2016-8-2_21-53-5.png


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

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
in the VBA editor, did you set a reference to the Microsoft outlook object model under tools, references?
 

Ron Legg

New Member
Outlook version
Outlook 2016 64 bit
Email Account
Exchange Server
Hi

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

Diane Poremsky

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
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

New Member
Outlook version
Outlook 2016 64 bit
Email Account
Exchange Server
Hi

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

upload_2016-8-3_0-21-46.png


upload_2016-8-3_0-22-58.png


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

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
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

New Member
Outlook version
Outlook 2016 64 bit
Email Account
Exchange Server
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

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
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

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
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

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
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.

Code:
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

New Member
Outlook version
Outlook 2016 64 bit
Email Account
Exchange Server
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

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
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

New Member
Outlook version
Outlook 2016 64 bit
Email Account
Exchange Server
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

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
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.
 
Top