How to open a specific Calendar in Outlook

Question

Hi,
I'm struggling to find an example on other forums, or not understanding the code.
I want to open a non-default calendar in Outlook to create an appointment (it's a hotmail account, which is shared with a couple of people, so that they can all see the same appointment in outlook).
The account is in the form of "[email protected]".  I've tried 3 different examples I've found on forums and none work.  Here's the code that works for the default calendar, so I'm after the code to open the specific calendar (the
variable passed as strCalendar).
Public Function fnCreateOutlookAppointment(strStartDate As String, Optional strEndDate As String, Optional strEventTitle As String, Optional strLocation As String, Optional strDetails As String, Optional intDuration As Integer, Optional strStartTime As String,
Optional strEmailList As String, Optional strStatus As String, Optional strAction As String, Optional blnAllDay As Boolean, Optional intReminderTime As Integer, Optional strCalendar As String)
    Dim olApp As New outlook.Application
    Dim olAppointment As AppointmentItem
    Dim myRequiredAttendee As outlook.Recipient
    Set olAppointment = olApp.CreateItem(olAppointmentItem)
    If Len(strStartTime) < 1 Then
        strStartTime = "09:00:00"
    End If
    If blnAllDay = Null Then
        blnAllDay = False
    End If
    If Len(strEndDate) < 1 Then
        strEndDate = strStartDate
    End If
    With olAppointment
        .Start = DateValue(strStartDate) + TimeValue(strStartTime)
        .Duration = intDuration
        .Subject = strEventTitle
        .Location = strLocation
        .Body = strDetails
        Select Case strStatus
            Case "Free"
                .BusyStatus = olFree
            Case Else
                .BusyStatus = olBusy
        End Select
        Select Case blnAllDay
            Case True
                .AllDayEvent = True
            Case Else
                .AllDayEvent = False
        End Select
        .ReminderMinutesBeforeStart = intReminderTime 
        .ReminderSet = True
        If Len(strEmailList) > 0 Then  'only add if email addresses supplied (and using ; as a break e.g. "[email protected];[email protected]"
            Set myRequiredAttendee = .Recipients.Add(strEmailList)
            myRequiredAttendee.Type = olRequired
        End If
        If strAction = "save" Then
            .Save
        Else
            .Display
        End If
    End With
    Set olAppointment = Nothing
    Set olApp = Nothing
End Function
_________________________________________________________ Every day is a school day!

Answer 1

Hi ChrisJC,
To get the specific calendar folder (non-default folder), please refer to this code below:
Dim oNS As Outlook.NameSpace
Dim MyItemsFolder As Outlook.MAPIFolder
Dim myAppoint As Outlook.AppointmentItem
Set oNS = oApp.GetNamespace("MAPI")
Set MyItemsFolder = oNS.Folders("[email protected]").Folders.Item("Calendar")
Then you could add appointment item by using
Items.Add method.
Set myAppoint = MyItemsFolder.Items.Add(olAppointmentItem)
Regards
Starain
We are trying to better understand customer views on social support experience, so your participation in this interview project would be greatly appreciated if you have time. Thanks for helping make community forums a great place.
Click
HERE to participate the survey.