将约会发送到共享日历 [英] Send appointments to shared calendar

问题描述

我有一个脚本，可以从SharePoint网站获取实验室中断数据.根据某些条件，如果发生中断，它将向Outlook发送约会.

I have a script which gets lab outage data from a SharePoint site. Depending certain conditions and if an outage is to occur it sends an appointment to 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日历.

It's sending the lab outage details to my personal Outlook calendar.

是否可以将详细信息发送到共享日历?

Is there a way to send the details to the shared calendar?

推荐答案

添加到非默认文件夹中.

Add to non-default folders.

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

这篇关于将约会发送到共享日历的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！