Creating calendar item in non-default calendar

Hi All

It's been a while since I have posted here but I am completely stumped with this one and looking for help.

I have the following code to create an appointment in Outlook using data froma worksheet:

Sub CreateAppointment()

    Dim oApp As Outlook.Application
    Dim oNameSpace As Namespace
    Dim oItem As AppointmentItem
    Dim RowNumber As Integer
    Dim AppStartTime As String
    Dim AppEndTime As String
                
    RowNum = ActiveCell.Row
    
    On Error Resume Next
' check if Outlook is running
    Set oApp = GetObject("Outlook.Application")
    If Err <> 0 Then
'if not running, start it
    Set oApp = CreateObject("Outlook.Application")

    End If
    
    Set oNameSpace = oApp.GetNamespace("MAPI")
    Set oItem = oApp.CreateItem(olAppointmentItem)
        
'' Get Start Date/Time
    If Worksheets("OrderDetails").Range("R" & RowNum).Value = "" Then
        AppStartTime = Now
    Else
        AppStartTime = Worksheets("OrderDetails").Range("R" & RowNum).Value + Worksheets("OrderDetails").Range("S" & RowNum).Value
    End If

'' Get End Time
    If Worksheets("OrderDetails").Range("T" & RowNum).Value = "" Then
        AppEndTime = AppStartTime + 0.5
    Else
        AppEndTime = Worksheets("OrderDetails").Range("R" & RowNum).Value + Worksheets("OrderDetails").Range("T" & RowNum).Value
    End If

''Adjust Details of Calendar Item
    With oItem

        .Subject = Worksheets("OrderDetails").Range("N" & RowNum)
        .Start = AppStartTime
        .End = AppEndTime

        .AllDayEvent = False
        .Importance = olImportanceNormal
        .Location = Worksheets("OrderDetails").Range("O" & RowNum)

        .ReminderSet = True
        .ReminderMinutesBeforeStart = "10"
        .ReminderPlaySound = True
        .ReminderSoundFile = "C:\Windows\Media\Ding.wav"

        Select Case 2 
            Case 1
                .Display
            Case 2
                .Save
        End Select

    End With
      
      
Set oApp = Nothing
Set oNameSpace = Nothing
Set oItem = Nothing

End Sub

This is fine for creating a calendar item in the default calendar however I am trying to create (or create then move) the appointment in a shared calendar.

I have found several examples however I can't seem to get any of them to work with my code. Any help would be greatly appreciated.

Thanks
Mark