如何使用 Excel 在 Outlook 365 Exchange 中引用组或共享日历? [英] How to reference group or shared calendar in Outlook 365 Exchange using Excel?

问题描述

我正在尝试让多个用户能够使用 Excel 将约会添加到共享日历.

I'm trying to have multiple users be able to add an appointment to a shared calendar using Excel.

以下代码对我有用.我拥有共享日历，它位于 Outlook365 中的日历文件夹中.

The following code works for me. I own the shared calendar and it resides in my Calendar folder in Outlook365.

Sub CreateAppt()

Const olFolderCalendar = 9
Const olPublicFoldersAllPublicFolders = 18
Const olAppointmentItem = 1 '1 = Appointment


Set objOutlook = CreateObject("Outlook.Application")
Set objNameSpace = objOutlook.GetNamespace("MAPI")
Set items = objNameSpace.GetDefaultFolder(olFolderCalendar).items

'check to see if calendar exists
For i = 1 To objNameSpace.GetDefaultFolder(olFolderCalendar).Folders.Count

If objNameSpace.GetDefaultFolder(olFolderCalendar).Folders.Item(i).Name = "Maintenance Task Manager" Then

    'set calendar name and set new appointment
    Set objCalendar = objNameSpace.GetDefaultFolder(olFolderCalendar).Folders("Maintenance Task Manager")
    Set objapt = objCalendar.items.Add(olAppointmentItem)

    'create appointment for PM
    With objapt
        .Subject = "PM Due for " & ActiveSheet.Range(PMcell).Offset(0, -6).Value
        .Location = ActiveSheet.Range(PMcell).Value
        .AllDayEvent = True
        .Start = ActiveSheet.Range(PMcell).Value
        .ReminderSet = True
        .ReminderMinutesBeforeStart = 10080
        If Not emailaddy = "" Then
            .Recipients.Add (emailaddy)
        End If
        .BusyStatus = olFree
        .Categories = "Equipment PM's"
        .body = PersonResponsible & ", you are responsible for the PM on this piece of equipment due on " & Format(DueDate, "Long Date")
    .Save
    End With
    Exit Sub
End If
Next i
End Sub

该代码在日历文件夹中查找名为维护任务管理器"的日历.

The code looks for a calendar called "Maintenance Task Manager" in the Calendar folder.

问题是在其他用户的 Outlook 中，此文件夹不在日历文件夹中，因此无法找到.它似乎不在任何文件夹中.

The problem is in other users' Outlook this folder is not in the Calendar folder and therefore cannot be found. It seems to not be in any folder.

推荐答案

我最终找到了一个非常适合我的情况的解决方案.我必须在 Outlook365 中添加一个新组并与我的具有读/写权限的用户共享.接受后，他们必须将小组日历添加到他们的收藏夹中.

I ended up finding a solution that works great in my situation. I had to add a new group in Outlook365 and share it with my users with read/write permissions. After they accepted, they had to add the group calendar into their favourites.

感兴趣的人的代码如下.

The code for anyone interested is as follows.

Sub Test()

Const olFolderCalendar = 9
Const olModuleCalendar = 1
Const olAppointmentItem = 1
Dim answer As Integer
Dim objNS
Dim objExpCal
Dim objNavMod
Dim objNavGroup
Dim objNavFolder
Dim objFolder
Dim colExpl

Set oApp = CreateObject("Outlook.Application")
Set objNS = oApp.Session
Set colExpl = oApp.Explorers
Set objExpCal = objNS.GetDefaultFolder(olFolderCalendar).GetExplorer
Set objNavMod = objExpCal.NavigationPane.Modules.GetNavigationModule(olModuleCalendar)

For Each objNavGroup In objNavMod.NavigationGroups
    For Each objNavFolder In objNavGroup.NavigationFolders
        If Not objNavFolder = "SHARED CALENDAR NAME" Then '<<must be named exactly as in the nav pane in outlook
            GoTo NxtGroup
        End If
        On Error Resume Next
        Set objFolder = objNavFolder.Folder

NxtGroup:
    Next
Next

Set objCalendar = objFolder
Set objapt = objCalendar.items.Add(olAppointmentItem)

    'create an appointment to schedule PM with outside contractor
    With objapt
        .Subject = "SUBJECT HERE"
        .Location = "LOCATION HERE
        .AllDayEvent = True 'or comment out and add an .End = line
        .Start = "SOME DATE HERE"
        .ReminderSet = True
        .ReminderMinutesBeforeStart = 10080
        .BusyStatus = olFree
        .Categories = "MUST HAVE SOMETHING HERE TO BE ABLE TO DELETE THE EVENT IF NEEDED"
        .body = ""
        .Display 'or .Save
    End With

Set objNS = Nothing
Set objNavMod = Nothing
Set objNavGroup = Nothing
Set objNavFolder = Nothing
Set objFolder = Nothing
Set colExpl = Nothing

End Sub

这篇关于如何使用 Excel 在 Outlook 365 Exchange 中引用组或共享日历?的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！