Write in different shared calendars RRS feed

  • Question

  • I have created a user form with which I can enter appointments in Outlook. Now I also want to have the option to write in one of four shared calendars. Does somebody has any idea?

    a part of my code:

    Sub TermineNachOutlookÜbernehmen()

        Dim objOutlook As Outlook.Application
        Dim apptOutlook As Outlook.AppointmentItem
        Dim olNS As Outlook.NameSpace
        Dim olCal As Outlook.MAPIFolder
        Dim i As Long
        Set objOutlook = Application
        Set olNS = objOutlook.GetNamespace("MAPI")
        On Error Resume Next
        Set olCal = olNS.GetDefaultFolder(olFolderCalendar).Folders(kalender) 'existiert der Kalender?
        If Err Then
             Set olCal = olNS.GetDefaultFolder(olFolderCalendar).Folders.Add(kalender) 'wenn nein erstellen
        End If
             ScreenUpdating = False
         Set apptOutlook = objOutlook.CreateItem(olAppointmentItem)
         With apptOutlook
            .ReminderPlaySound = False
            .Subject = s
            .Body = Kommentar
            .Location = Raum
            .Start = datum + Beginn
            .Duration = Dauer
            '.ReminderMinutesBeforeStart = 10
            .ReminderSet = False
            .Categories = strFarbkat
            .Move olCal
         End With
         Set apptOutlook = Nothing
         Set objOutlook = Nothing
    ScreenUpdating = True

       Set apptOutlook = Nothing
       Set olCal = Nothing
       Set olNS = Nothing
       Set objOutlook = Nothing

    End Sub

    • Edited by suwis Wednesday, November 13, 2019 1:39 PM
    Wednesday, November 13, 2019 1:33 PM