VBA - Как открыть последнюю встречу, созданную программно?

Question

Я узнал, как создать и сохранить новую встречу с VBA из Excel в Outlook, однако я хотел бы получить какое-то подтверждение того, что оно сохранено, без необходимости переключаться в Outlook, определять местонахождение дня и искатьделовое свидание, встреча.Самое близкое, что я пришел, - это создание / сохранение, а затем отображение внешнего вида каландар.

Private Sub CommandButton1_Click()


    Dim olApp As Outlook.Application
    Dim olApt As AppointmentItem


    Set olApp = New Outlook.Application
    Set olApt = olApp.CreateItem(olAppointmentItem)


    With olApt
        .Start = Date + 1 + TimeValue("19:00:00")
        .End = .Start + TimeValue("00:30:00")
        .Subject = "Piano lesson"
        .Location = "The teachers house"
        .Body = "Don't forget to take an apple for the teacher"
        .BusyStatus = olBusy
        .ReminderMinutesBeforeStart = 120
        .ReminderSet = True
        .Save
    End With

    olApp.Session.GetDefaultFolder(olFolderCalendar).Display
    Set olApt = Nothing
    Set olApp = Nothing



End Sub

Answer 1

Вы можете создать функцию, которая возвращает логическое значение, чтобы указать, существует собрание или нет.Я сделал некоторые предположения и сделал такую ​​функцию.Я определил подходящее собрание как совпадающее: продолжительность, дата и тема собрания.

Я только что заставил эту функцию возвращать Debug.Print, но как только вы узнаете, что она существует, вы можете делать все, что угодно.Вам нравится с этой информацией.

Option Explicit

Public Sub Example()
    Dim olApp As Outlook.Application: Set olApp = New Outlook.Application
    Dim olApt As AppointmentItem: Set olApt = olApp.CreateItem(olAppointmentItem)
    Dim MeetingStartDate As Date: MeetingStartDate = Date + 1 + TimeValue("19:00:00")

    With olApt
        .Start = MeetingStartDate
        .End = .Start + TimeValue("00:30:00")
        .Subject = "Piano lesson"
        .Location = "The teachers house"
        .Body = "Don't forget to take an apple for the teacher"
        .BusyStatus = olBusy
        .ReminderMinutesBeforeStart = 120
        .ReminderSet = True
        .Save
    End With

    If MeetingExists(MeetingStartDate, 30, "Piano lesson") Then
        Debug.Print "The meeting exists!"
    Else
        Debug.Print "The meeting does not exist!"
    End If

End Sub

'Check all meetings for that day. A match is defined as having the same meeting subject and duration
'Adapted from: https://docs.microsoft.com/en-us/office/vba/outlook/how-to/search-and-filter/search-the-calendar-for-appointments-within-a-date-range-that-contain-a-specific
Public Function MeetingExists(StartDate As Date, Duration As Long, MeetingSubject As String) As Boolean
    MeetingExists = False
    Dim oCalendar               As Outlook.Folder: Set oCalendar = Application.Session.GetDefaultFolder(olFolderCalendar)
    Dim oItems                  As Outlook.Items: Set oItems = oCalendar.Items
    Dim oItemsInDateRange       As Outlook.Items
    Dim oAppt                   As Outlook.AppointmentItem
    Dim strRestriction          As String
    Dim EndDate                 As Date

    EndDate = DateAdd("d", 1, StartDate)
    strRestriction = "[Start] >= '" & Format$(StartDate, "mm/dd/yyyy hh:mm AMPM") & _
                     "' AND [End] <= '" & Format$(EndDate, "mm/dd/yyyy hh:mm AMPM") & "'"

    oItems.IncludeRecurrences = True
    oItems.Sort "[Start]"
    Set oItemsInDateRange = oItems.Restrict(strRestriction)

    For Each oAppt In oItemsInDateRange
        If oAppt.Subject = MeetingSubject And oAppt.Duration = Duration Then
            MeetingExists = True
            Exit Function
        End If
    Next

End Function