Send MS Project Tasks to a different Outlook calendar instead of my default

Question

This code sends MS Project Tasks to Outlook as events.

I want to set it to a different calendar instead of my default.

The original code:

Sub Export_Selection_To_OL_Appointments()
Dim myTask As Task
Dim myItem As Object
    
On Error Resume Next
Set myOLApp = CreateObject("Outlook.Application")
  
For Each myTask In ActiveSelection.Tasks
    Set myItem = myOLApp.CreateItem(1)
    With myItem
        .Start = myTask.Start
        .End = myTask.Finish
        .Subject = " Rangebank PS " & myTask.Name
        .Categories = myTask.Project
        .Body = myTask.Notes
        .Save
    End With
Next myTask

End Sub

Tried code I found online.

Answer 1

This demonstrates how you could reference a non-default Outlook folder to add an item.

Option Explicit

Sub NonDefaultFolder_Add_Not_Create()

Dim myOlApp As Object
Dim myDefaultStore As Object

Dim nonDefaultCalendar As Object
Dim myItem As Object

On Error Resume Next
Set myOlApp = CreateObject("Outlook.Application")

' Consider this mandatory.
' Limit the scope of the error bypass to the minimum number of lines.
' Ideally the scope is zero lines.
On Error GoTo 0

If Not myOlApp Is Nothing Then

    Set myDefaultStore = myOlApp.Session.defaultStore
    Debug.Print myDefaultStore
    
    ' This references a calendar on the same level as the default calendar
    Set nonDefaultCalendar = myOlApp.Session.Folders(myDefaultStore.DisplayName).Folders("Calendar Name")
    nonDefaultCalendar.Display
    
    ' Add to non-default folders (or create in the default then copy or move)
    Set myItem = nonDefaultCalendar.Items.Add
    With myItem
        .Subject = " Rangebank PS "
        .Display
    End With

Else
    MsgBox "Error creating Outlook object."
    
End If

End Sub