공유 일정에 약속 보내기

Question

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 일정에 실험실 중단 세부 정보가 전송됩니다.

공유 캘린더에 세부 정보를 보내는 방법이 있습니까?

Answer 1

기본 폴더가 아닌 폴더에 추가하십시오.

Set olkCalendar = olkSession.GetSharedDefaultFolder(myRecipient, olFolderCalendar) 
Set myapt = olkCalendar.Items.Add 
With myapt 
    … 
    .Save 
    ' Send 
End With