Bdtjtk

I have learned how to create and save a new appointment with VBA from excel to outlook, however I would like to see some sort of confirmation that it has saved without having to switch to outlook, locate the day, and look for the appointment. The closest I have come is creating/saving, then displaying outlook calandar.

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

You can construct a function that returns a boolean to indicate if the meeting exists or not. I made some assumptions, and made such a function. I've defined a matching meeting as one that has a matching: duration, date, and meeting Subject.

I just made this function return a Debug.Print, but once you know it exists, you can do whatever you like with this information.

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