excel - Adding appointments to shared subfolders in Outlook Calendar

Question

I am trying to create a macro that will add appointments to a specific shared calendar. I am able to add to the default shared calendar when using a different computer, but for some reason, I am not able to add to the specific subfolder in the shared calendar. I get an error message that says "Object not found". I have tried changing the name of the shared folder owner between their email and their name but have not had much luck. I have tried using .Folders().Folders() but am not sure what I need to put in the first .Folders() spot to get it to refer to the correct folder. Should it be .Folders("Calendar").Folders("Install")?

The debugger always points to the line Set CalFolder = olNs.GetSharedDefaultFolder(objOwner, olFolderCalendar) and says that it cannot find an object.

Here is the code I have tried so far:

Sub create_FI_outlook_event()
'INSTALL
'This creates an Outlook appointment on the Install calendar.

Call openOL

Dim ol As Outlook.Application
Dim olAp As Outlook.AppointmentItem
Dim olNs As Outlook.Namespace
Dim CalFolder As Outlook.Folder
Dim objOwner As Outlook.Recipient
Dim SubFolder As Outlook.Folder

Set ol = New Outlook.Application
Set olNs = Outlook.GetNamespace("MAPI")
Set objOwner = olNs.CreateRecipient("shared folder owner's email")
objOwner.Resolve

Set CalFolder = olNs.GetSharedDefaultFolder(objOwner, olFolderCalendar)
Set SubFolder = CalFolder.Folders("Calendar").Folders("Install")

If objOwner.Resolved Then
Set olAp = SubFolder.Items.Add(olAppointmentItem)
End If
With olAp
    .Subject = ActiveSheet.Range("C6").Value
    .Location = ActiveSheet.Range("C7").Value
    .Start = Range("C5")
    .End = DateAdd("d", 1, Range("C5"))
    .Body = "Notes"
    .AllDayEvent = True
    .Display
    .Save
    End With
End Sub

Answer 1

等待大神答复