Eintrag in freigegebenen Kalender

Hallo zusammen,

ich verzweifel irgendwie an Outlook. Ich habe mir hier im Forum einen Code "geklaut" und etwas modifiziert. Ich möchte nicht in meinen Standardkalender in Outlook sondern in einen freigegebenen Gruppenkalender "TestKalender" schreiben.

Sub CreateOtherUserAppointment()
Dim objApp As Object
Dim objNS As Outlook.Namespace
Dim objFolder As Outlook.MAPIFolder
Dim objDummy As Outlook.MailItem
Dim objRecip As Outlook.Recipient
Dim objAppt As Outlook.AppointmentItem
Dim strMsg As String
Dim strName As String
On Error Resume Next
  strName = "Mein Name"
  'Wo setze ich hier den richtigen Kalender an?!
  StrKalender = "TestKalender"
  Set objApp = CreateObject("Outlook.Application")
  Set objNS = objApp.GetNamespace("MAPI")
  Set objDummy = objApp.CreateItem(olMailItem)
  Set objRecip = objDummy.Recipients.Add(strName)
  objRecip.Resolve
  If objRecip.Resolved Then
    On Error Resume Next
    Set objFolder = _
    objNS.GetSharedDefaultFolder(objRecip, olFolderCalendar)
    If Not objFolder Is Nothing Then
      Set objAppt = objFolder.Items.Add
      If Not objAppt Is Nothing Then
        With objAppt
          .Start = Format(Tabelle1.Range("B2").Value, "dd.mm.yyyy") & "08:00"
          .Subject = Tabelle1.Range("B1").Value
          .Duration = "60"
          .Save
        End With
      End If
    End If
  End If
  
  Set objApp = Nothing
  Set objNS = Nothing
  Set objFolder = Nothing
  Set objDummy = Nothing
  Set objRecip = Nothing
  Set objAppt = Nothing

  MsgBox "Die Termine wurden in den Kalender " & StrKalender & " eingetragen!"
End Sub