Selecting specific calendar from Excel

Status
Not open for further replies.

Paul Fisher

Member
Outlook version
Outlook 2013 32 bit
Email Account
IMAP
The following code creates an appointment in my default calendar.
How can I change it to select a specific calendar into which to add the appointment? I know the name of the Calendar but not it's Index number which might vary from user to user.

If IDCal = "Yes" Then
With CreateObject("Outlook.Application").CreateItem(1)
.Subject = ID_Time & " / " & Surname & " / " & "ID Visit"
.Start = ID_Date + " " + ID_Time
.Duration = 60
.Location = Client Office
.Save
End With
End If
 

Diane Poremsky

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
use items.add
Set CalFolder = olNs.GetDefaultFolder(olFolderCalendar)
Set subFolder = CalFolder.Folders("sub folder name")
Set olAppt = subFolder.Items.Add(olAppointmentItem)

if its in a shared folder, you'll need to use the shared folder code at the end of this article - Working with VBA and non-default Outlook Folders to identify it the reference it
Set olAppt = CalendarFolder.Items.Add(olAppointmentItem)
 

Paul Fisher

Member
Outlook version
Outlook 2013 32 bit
Email Account
IMAP
Thanks for your help, I'll try that and see if I can make it work. I am much more familiar with Excel than Outlook so it takes me a while to understand what is happening on the Outlook side.
 

Paul Fisher

Member
Outlook version
Outlook 2013 32 bit
Email Account
IMAP
use items.add
Set CalFolder = olNs.GetDefaultFolder(olFolderCalendar)
Set subFolder = CalFolder.Folders("sub folder name")
Set olAppt = subFolder.Items.Add(olAppointmentItem)

if its in a shared folder, you'll need to use the shared folder code at the end of this article - Working with VBA and non-default Outlook Folders to identify it the reference it
Set olAppt = CalendarFolder.Items.Add(olAppointmentItem)
Diane, many thanks for your help. I am having to use the Late Binding method as I cannot be sure which version of Outlook is running on the PCs. I have adapted my code so that I can now specify a subfolder of the default calendar. As I am self taught, it takes me quite a while to work these things out! However I can't begin to grasp how to access a Shared Folder using this method. Any further help/suggestions would be very much appreciated. My new code is below.

Sub Automateappt()

Dim applOutlook As Object
Dim nsOutlook As Object
Dim cfOutlook As Object
Dim ifOutlook As Object
Dim cffolder As Object
Dim olAppt As Object

Set applOutlook = GetObject(, "Outlook.Application")

Set nsOutlook = applOutlook.GetNamespace("MAPI")

Set cfOutlook = nsOutlook.GetDefaultFolder(9)
MsgBox cfOutlook

Set cffolder = cfOutlook.Folders(1)
MsgBox cffolder

'Set olAppt = applOutlook.CreateItem(1) ' 1 = olAppointmentItem
Set olAppt = cffolder.Items.Add ' this puts it in the correct calendar

With olAppt

.Subject = "Test Appt Subject"
.Start = "13/03/2016 11:45"
.Duration = 60
.Location = "Test Location"
.Save
End With

End Sub
 

Diane Poremsky

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
This line gets changed:
Set cfOutlook = nsOutlook.GetDefaultFolder(9)

You need to use the shared folder code from Working with VBA and non-default Outlook Folders instead.

Dim objOwner As Outlook.Recipient
Set objOwner = nsOutlook.CreateRecipient("maryc")
objOwner.Resolve

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

Paul Fisher

Member
Outlook version
Outlook 2013 32 bit
Email Account
IMAP
This line gets changed:
Set cfOutlook = nsOutlook.GetDefaultFolder(9)

You need to use the shared folder code from Working with VBA and non-default Outlook Folders instead.

Dim objOwner As Outlook.Recipient
Set objOwner = nsOutlook.CreateRecipient("maryc")
objOwner.Resolve

If objOwner.Resolved Then
'MsgBox objOwner.Name
Set cfOutlook = nsOutlook.GetSharedDefaultFolder(objOwner, olFolderCalendar)
End If
Diane - many thanks again..... should give me hours of fun to understand and implement your suggestion. Good job I am only doing this as a hobby!
 
Status
Not open for further replies.
Top