How to grab the Start time of current selected/active appointment in Desktop offline version Outlook 2019, using VBA from Excel?

Question

I am trying to get the Start time of the current selected appointment in Outlook, using VBA from Excel.

For example I have Outlook open, and today's 2pm appointment is selected. Excel is also open. I would like to run VBA from Excel, that will grab the Start time of the current appointment selected in Outlook. How do I do it please?

I tried this answer here: Determining selected Outlook Calendar date with VBA

The code is this:

 'This code is suppose to obtain the Start time of the current active Outlook appointment. 
 'I cannot get this code to work. 
 
 Sub CreateAppointmentUsingSelectedTime() 
 
      Dim datStart As Date 
      Dim datEnd As Date 
      Dim oView As Outlook.view 
      Dim oCalView As Outlook.CalendarView 
      Dim oExpl As Outlook.Explorer 
      Dim oFolder As Outlook.folder 
      Dim oAppt As Outlook.AppointmentItem 
      Const datNull As Date = #1/1/4501# 
    
      ' Obtain the calendar view using 
      ' Application.ActiveExplorer.CurrentFolder.CurrentView. 
      ' If you use oExpl.CurrentFolder.CurrentView, 
      ' this code will not operate as expected. 
      Set oExpl = Application.ActiveExplorer 
      Set oFolder = Application.ActiveExplorer.CurrentFolder 
      Set oView = oExpl.CurrentView 
    
      ' Check whether the active explorer is displaying a calendar view. 
      If oView.ViewType = olCalendarView Then 
      Set oCalView = oExpl.currentView 
      ' Create the appointment using the values in 
      ' the SelectedStartTime and SelectedEndTime properties as 
      ' appointment start and end times. 
      datStart = oCalView.SelectedStartTime 
      datEnd = oCalView.SelectedEndTime 
      Set oAppt = oFolder.items.Add("IPM.Appointment") 
      If datStart <> datNull And datEnd <> datNull Then 
       oAppt.Start = datStart 
       oAppt.End = datEnd 
      End If 
      oAppt.Display 
     End If 
End Sub 
 

When I ran it, I got this error:

Run-time error '438'. Object doesn't support this property or method

When I click "Debug", this following line is highlighted in yellow:

Set oExpl = Application.ActiveExplorer

In another related module, I have this following code shown below which takes the value of column 4 of current active row in Excel, and put that into the Subject of a new Appointment in Outlook. The code is shown below and it runs smoothly (for pasting value from column 4 of active row into Subject of new appointent). But when I tried the code shown above (for grabbing the Start time of current active appointment), the code shown above did not work.

'This code takes the value from column 4 of current active row in Excel
'Use that value as the Subject of new appointment in Outlook.
'This code works well. 

Option Explicit

Sub CreateEmailFromExcel()
    Dim OutApp As Outlook.Application
    Dim OutMeet As Outlook.AppointmentItem
    Set OutApp = Outlook.Application
    'Set OutMeet = OutApp.CreateItem(olAppointmentItem)


        'Declare Outlook Variables
        'Dim OutApp As Outlook.Application

        On Error Resume Next
        'Get the Active instance of Outlook
        Set OutMeet = GetObject(, "Outlook.AppointmentItem")

        'If error create a new instance of Outlook.Application
        If Err.Number = 429 Then

            'Clear Error
            Err.Clear

            'Create a new instance of Outlook
            Set OutMeet = OutApp.CreateItem(olAppointmentItem)

        End If

    Dim r As Long
    r = ActiveCell.Row

    With OutMeet
        '.Subject = "Invitation to a Test meeting"
        '.Subject = Cells(2, 1).Value
        '.Subject = ActiveCell.Value
        '.Subject = ActiveCell.Offset(0, 2).Value
        .Subject = Cells(r, 4).Value

        .RequiredAttendees = "edge@edge.com, Johncena@cena.com, Hulk@mania.com"
        .OptionalAttendees = "RomanReigns@fatu.com"
        .Start = #11/9/2022 6:00:00 PM#
        .Duration = 90
        .Importance = olImportanceHigh
        .ReminderMinutesBeforeStart = 15
        .Body = "Dear All" & vbLf & vbLf & "You are invited" & vbLf & vbLf & "Kind Regards"
        '.Attachments.Add ("C:\users\vicmo\desktop\forcombotest2.xlsx")
        .MeetingStatus = olMeeting
        .Location = "Microsoft Teams"
        .Display
    End With

    Set OutApp = Nothing
    Set OutMeet = Nothing
End Sub

My ultimate goal is this:

(1) The user has selected an active appointment in Outlook. 
(2) The user has selected an active row in Excel. 
(3) Have VBA take the value from column 4 of active row in Excel, use that as the Subject to open a new appointment at the Start time of current active appointment in Outlook. 

How do I achieve please? Thanks a lot.

I use offline Desktop version of Microsoft Office 2019 on Windows 10 (64 bit).

Answer 1

First, there is no need to use the View object returned by the CurrentView property of the Folder or Explorer class like you tried in the first sample code.

Second, a new appointment item is not related to the selected one in Outlook. So, it is useless in that scenario.

Instead, you can use the Selection property of the Explorer class which returns a Selection object that contains the item or items that are selected in the explorer window. For example:

Sub GetSelectedItems() 
 Dim myOlExp As Outlook.Explorer 
 Dim myOlSel As Outlook.Selection 
 Dim mySender As Outlook.AddressEntry 
 Dim oMail As Outlook.MailItem 
 Dim oAppt As Outlook.AppointmentItem 
 Dim oPA As Outlook.PropertyAccessor 
 Dim strSenderID As String 
 Const PR_SENT_REPRESENTING_ENTRYID As String = "http://schemas.microsoft.com/mapi/proptag/0x00410102" 
 Dim MsgTxt As String 
 Dim x As Long 

 MsgTxt = "Senders of selected items:" 
 Set myOlExp = Application.ActiveExplorer 
 Set myOlSel = myOlExp.Selection 
 For x = 1 To myOlSel.Count 
   If myOlSel.Item(x).Class = OlObjectClass.olMail Then 
     ' For mail item, use the SenderName property. 
     Set oMail = myOlSel.Item(x) 
     MsgTxt = MsgTxt & oMail.SenderName & ";" 
   ElseIf myOlSel.Item(x).Class = OlObjectClass.olAppointment Then 
     ' For appointment item, use the Organizer property. 
     Set oAppt = myOlSel.Item(x) 
     MsgTxt = MsgTxt & oAppt.Organizer & ";" 

     Debug.Print oAppt.Start
    
   Else 
     ' For other items, use the property accessor to get the sender ID, 
     ' then get the address entry to display the sender name. 
     Set oPA = myOlSel.Item(x).PropertyAccessor 
     strSenderID = oPA.GetProperty(PR_SENT_REPRESENTING_ENTRYID) 
     Set mySender = Application.Session.GetAddressEntryFromID(strSenderID) 
     MsgTxt = MsgTxt & mySender.Name & ";" 
   End If 
 Next x 
 Debug.Print MsgTxt 
End Sub