如何向Outlook中的共享日历添加约会？

我正在尝试编写一个macros，它将创build一个从带有Subject和Date的.CSV文件中取得的约会，并将其放置在其他人的共享日历中。 我对这个共享日历有完整的编辑权限。 通过共享日历，我的意思是，在个人的Outlook中制作的常规日历，只需点击“分享”并通过电子邮件发送给他人共享即可。

看来，login的用户只能将约会添加到他们自己的日历中，而不能添加他们有权访问的共享日历。

 Sub ImportAppointments(full_path As String) 'Initialize variables Dim exlApp As Excel.Application Dim exlWkb As Workbook Dim exlSht As Worksheet Dim rng As Range Dim itmAppt As Outlook.AppointmentItem ' Create reference to Excel Set exlApp = New Excel.Application ' Select file path, currently hardcoded to one directory, change as needed Dim strFilepath As String 'strFilepath = "P:\Holiday Calendar\Holiday_Calendar_Data.csv" strFilepath = full_path ' Select workbook (the above .csv file) and select the first worksheet as the data sheet Set exlSht = Excel.Application.Workbooks.Open(strFilepath).Worksheets(1) ' Initialize variables Dim iRow As Integer Dim iCol As Integer Dim oNs As Namespace Dim olFldr As Outlook.MAPIFolder Dim objOwner As Outlook.Recipient ' Allow accessing data stored in the user's mail stores in Outlook Set oNs = Outlook.GetNamespace("MAPI") ' Set share calender owner Set objOwner = oNs.CreateRecipient("[e-mail]") objOwner.Resolve If objOwner.Resolved Then ' Set up non-default share folder location Set olFldr = oNs.GetSharedDefaultFolder(objOwner, olFolderCalendar).Folders("Holiday Calendar") End If ' Start point iRow = 2 iCol = 1 ' Loop through each calendar entry While exlSht.Cells(iRow, 1) <> "" Set itmAppt = Outlook.CreateItem(olAppointmentItem) ' Set appointment Subject, ie (Vacation, Sick Day, Half-Day, etc.) itmAppt.Subject = exlSht.Cells(iRow, 1) ' Set Date of Event itmAppt.Start = exlSht.Cells(iRow, 2) ' Force All Day Event itmAppt.AllDayEvent = True ' Save appointment itmAppt.Save ' Advance pointer to next row iRow = iRow + 1 ' Transfer appointment into shared calendar folder itmAppt.Move olFldr Wend ' Close everything Excel.Application.Workbooks.Close exlApp.Quit Set exlApp = Nothing Set olFldr = Nothing Set itmAppt = Nothing End Sub 

如果我试图插入别人的日历（ Set olFldr = oNs.GetSharedDefaultFolder(objOwner, olFolderCalendar).Folders("Holiday Calendar") ），但我的代码未能find"Holiday Calendar" 。 请指教。

Answer 1

而不是调用Application.CreateItem / AppointmentItem.Move ，直接使用olFldr.Items.Add创build项目。