Question

我正在尝试编写一个宏，该宏将创建一个带有主题和日期的outputFile文件的约会，并将其放在其他人的共享日历中。我拥有此共享日历的完整编辑权限。通过共享日历，我的意思是，在人的Outlook中制作常规日历，只需点击“分享”并通过电子邮件发送给其他人分享。

似乎登录的用户只能将约会添加到他们自己的日历中，而不能将他们拥有权限的共享日历添加到他们自己的日历中。

.CSV

如果我尝试插入其他人的日历（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("calvin@xyz.ca") 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）而不是我自己的日历，则我的代码无法找到"Holiday Calendar"。请指教。

Answer 1

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

Answer 2

如果您要写入的日历与默认日历位于同一文件夹级别，则此行代码略有偏离：

Set olFldr = oNs.GetSharedDefaultFolder(objOwner, olFolderCalendar).Folders("Holiday Calendar")

相反，您需要在.Folders属性之前指定.Parent

Set olFldr = oNs.GetSharedDefaultFolder(objOwner, olFolderCalendar).Parent.Folders("Holiday Calendar")

我从https://www.slipstick.com/developer/working-vba-nondefault-outlook-folders/

得出了这个答案

Answer 3

分享这一点，我花了很长时间才想出一种从Exchange共享邮箱添加日历会议请求的解决方案。

此代码创建，显示并预填写一个约会，该约会将保存在“共享邮箱”中，并且如果发送给其他收件人，则该收件人将显示为从共享邮箱帐户发送的约会！

Sub SendEmailFromSharedMailbox()
Dim olApp As Outlook.Application
    Set olApp = Outlook.Application

Dim olNS As Outlook.Namespace
  Dim objOwner As Outlook.Recipient

  Set olNS = olApp.GetNamespace("MAPI")
  Set objOwner = olNS.CreateRecipient("Shared Mailbox Name")
    objOwner.Resolve

 If objOwner.Resolved Then
   MsgBox objOwner.Name
 Set newCalFolder = olNS.GetSharedDefaultFolder(objOwner, olFolderCalendar)

'Now create the email
 Set olAppt = newCalFolder.Items.Add(olAppointmentItem)
     With olAppt
     'Define calendar item properties
        .Start = "19/9/2019 2:00 PM"
        .End = "19/9/2019 2:30 PM"
        .Subject = "Appointment Subject Here"
        .Recipients.Add ("someone@email.com")
        'Add more variables as required, eg reminder, importance, etc
        .Display
    End With
 End If

End Sub

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

3 个答案: