将约会发送到共享日历
我有一个脚本，从SharePoint网站获取实验室停机数据。 根据一定的条件，如果发生停电，它会向Outlook发送预约。
Private Sub CreateAppt(Subject As String, startTime As Date, endTime As Date, _ startDate As Date, endDate As Date, superString As String, _ OUTAGEREQUIRED As String) Dim body As String: Dim myoutlook As Outlook.Application Dim myRecipient As Outlook.Recipient Dim myNameSpace As Outlook.Namespace Dim olkCalendar As Object Dim olkSession As Object Dim myapt As Object ' Outlook.AppointmentItem 'Dim r As Long ' late bound constants Const olAppointmentItem = 1 'Const olBusy = 2 Const olMeeting = 1 ' Create the Outlook session 'On Error GoTo meetingFailed Set myoutlook = Outlook.Application 'CreateObject("Outlook.Application") Set olkSession = myoutlook.Session Set myNameSpace = myoutlook.GetNamespace("MAPI") Set myRecipient = myNameSpace.CreateRecipient("***@.com") 'Create the AppointmentItem 'On Error GoTo meetingFailed Set myapt = myoutlook.CreateItem(olAppointmentItem) olkSession.Logon Set olkCalendar = olkSession.GetSharedDefaultFolder(myRecipient, olFolderCalendar) ' Set the appointment properties With myapt .Subject = Subject .body = superString .Start = startDate & " " & startTime .End = endDate & " " & endTime .MeetingStatus = olMeeting .ReminderSet = True .ReminderMinutesBeforeStart = "5" 'Conditional check -> if outageRequired is true then ' set BusyStatus to Busy and Color to red If (OUTAGEREQUIRED = True) Then .BusyStatus = 2 .Categories = "Red Category" 'Conditional check -> if OutageRequired is false then ' set BusyStatus to Free and Color to Blue ElseIf (OUTAGEREQUIRED = False) Then .BusyStatus = 0 .Categories = "Blue Category" End If 'Send emails to hardcoded email addresses 'Primary email address is ******@***.com If Not DEBUGCODE Then .Recipients.Add "****@.com" Else .Recipients.Add "***@.com" End If .Recipients.ResolveAll .Save .Send End With Exit Sub 这是实验室中断的详细信息发送到我个人的Outlook日历。
有没有办法将详细信息发送到共享日历？
添加到非默认文件夹。
Set olkCalendar = olkSession.GetSharedDefaultFolder(myRecipient, olFolderCalendar) Set myapt = olkCalendar.Items.Add With myapt … .Save ' Send End With