Question

我已经学习了如何使用VBA从excel创建新的约会并将其保存到Outlook，但是我希望看到某种确认，它已经保存，而无需切换到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

VBA-如何打开以编程方式创建的最后一个约会？

1 个答案: