是否可以将收件人添加到 outlook AppointmentItem,然后仅发送给添加的收件人?

Is it possible to add a recipient to an outlook AppointmentItem and then send only to the added recipient?

提问人:ICSOTSecurityEngineer 提问时间:11/8/2023 最后编辑:Tim WilliamsICSOTSecurityEngineer 更新时间:11/9/2023 访问量:14

问:

我正在尝试解析我的所有日历项目,并检查它们是否已发送给特定收件人。如果不是,我想转发给该收件人。或者,我想添加一个收件人,然后只发送给添加的收件人,但我看不到这样做的方法。

到目前为止,我有这个:

Sub ForwardCalendarItems()

'This code will iterate through all the appointments the calendar for the next three months. For each appointment, it checks if the invitee’s email is in the list of recipients. If not, it forwards the appointment to the invitee. 

    Dim olApp As Outlook.Application
    Dim olNS As Outlook.NameSpace
    Dim olFolder As Outlook.MAPIFolder
    Dim olItems As Outlook.Items
    Dim olAppt As Outlook.AppointmentItem
    Dim olRecipients As Outlook.Recipients
    Dim olRecipient As Outlook.Recipient
    Dim DateStart As Date
    Dim DateEnd As Date
    Dim InviteeEmail As String
    Dim Found As Boolean

    InviteeEmail = "" ' Initial setting to ensure is clear

    Set olApp = New Outlook.Application
    Set olNS = olApp.GetNamespace("MAPI")
    Set olFolder = olNS.GetDefaultFolder(olFolderCalendar)
    Set olItems = olFolder.Items

    DateStart = Date
    DateEnd = DateAdd("m", 3, DateStart)
    olItems.Sort "[Start]"
    olItems.IncludeRecurrences = True

    Set olAppt = olItems.Find("[Start] >= """ & DateStart & """ and [Start] <= """ & DateEnd & """")


'Spirit Email

InviteeEmail = "[email protected]" 'SE eMail TC

    While TypeName(olAppt) <> "Nothing"
        Found = False
        Set olRecipients = olAppt.Recipients
        For Each olRecipient In olRecipients
            If olRecipient.Address = InviteeEmail Then
                Found = True
                Exit For
            End If
        Next
        If Not Found Then
            olAppt.ForwardAsVcal.Recipients.Add InviteeEmail
            olAppt.ForwardAsVcal.Send
        End If
        Set olAppt = olItems.FindNext
    Wend



    Set olAppt = Nothing
    Set olItems = Nothing
    Set olFolder = Nothing
    Set olNS = Nothing
    Set olApp = Nothing

End Sub

任何指导都非常非常感谢,我是Outlook VBA的新手。

谢谢!!

请查看粘贴的代码,谢谢!

VBA Outlook 任命 Outlook-2016

评论


答: 暂无答案