Exchange Online, Outlook365: Kalender im Public Folder wird nicht in "Other Calendars" angezeigt

strFolder = "Public Folders - " & GetMyEmail() & "\All Public Folders\Local Winterthur Holidays"  
Call AddFolderToFavorites(strFolder, True)

Sub AddFolderToFavorites(strPath, AddToAddressBook)
                Const olContactItem = 2
                Set myFolder = GetFolder(strPath)
                If Not myFolder Is Nothing Then
                               myFolder.AddToPFFavorites
                               ' if contacts folder,  
                               ' optionally add new Favorite to OAB  
                               If myFolder.DefaultItemType = olContactItem Then
                                               If AddToAddressBook = True Then
                                                               strFavFolder = _
                                                               "Public Folders\Favorites\" & _  
                                                               myFolder.Name
                                                               Set myFavFolder = GetFolder(strFavFolder)
                                                               If Not myFavFolder Is Nothing Then
                                                                               myFavFolder.ShowAsOutlookAB = True
                                                               End If
                                               End If
                               End If
                End If
                Set myFolder = Nothing
End Sub

Public Function GetFolder(strFolderPath)
                On Error Resume Next
                strFolderPath = Replace(strFolderPath, "/", "\")  
                arrFolders = Split(strFolderPath, "\")  
                Set objApp = CreateObject("Outlook.Application")  
                Set objNS = objApp.GetNamespace("MAPI")  
                Set objFolder = objNS.Folders.Item(arrFolders(0))
                If Not objFolder Is Nothing Then
                               For I = 1 To UBound(arrFolders)
                               Set colFolders = objFolder.Folders
                               Set objFolder = Nothing
                               Set objFolder = colFolders.Item(arrFolders(I))
                               If objFolder Is Nothing Then
                                               Exit For
                               End If
                               Next
                End If
                Set GetFolder = objFolder
                Set colFolders = Nothing
                Set objNS = Nothing
                Set objApp = Nothing
End Function

Public Function GetMyEmail()
                Set objSysInfo = CreateObject("ADSystemInfo")  
                strUserPath = "LDAP://" & objSysInfo.UserName  
                Set objUser = GetObject(strUserPath)
                GetMyEmail = objUSer.Mail
End Function