Microsoft Office Forums Automatically Creating an Appointment

Go Back   Microsoft Office Forums > >

Reply
 
Thread Tools Display Modes
  #1  
Old 02-08-2018, 12:21 PM
dubczech dubczech is offline Automatically Creating an Appointment Windows 10 Automatically Creating an Appointment Office 2016
Novice
Automatically Creating an Appointment
 
Join Date: Feb 2018
Posts: 1
dubczech is on a distinguished road
Default Automatically Creating an Appointment

I'm trying to find a way to automatically add a 30 minute appointment after every meeting I accept. I found the below code on the web, but it requires you to go into your calendar, select the meeting, then manually run the macro.

My thought was that I could add a custom button to the toolbar that acted as the "Accept" button and then schedule the 30 minute follow-up meeting.

Any thoughts/assistance would be very much appreciated.

Code:
Public Sub AddBreakTime()
  Dim coll As VBA.Collection
  Dim obj As Object
  Dim Appt As Outlook.AppointmentItem
  Dim FreeTime As Outlook.AppointmentItem
  Dim Items As Outlook.Items
  Dim Before&, After&
  Dim Category$, Subject$

  '1. Block minutes before and after the appointment
  Before = 30
  After = 30

  If Before = 0 And After = 0 Then Exit Sub

  Set coll = GetCurrentItems
  If coll.Count = 0 Then Exit Sub
  For Each obj In coll
    If TypeOf obj Is Outlook.AppointmentItem Then
      Set Appt = obj
      If TypeOf Appt.Parent Is Outlook.AppointmentItem Then
        Set Items = Appt.Parent.Parent.Items
      Else
        Set Items = Appt.Parent.Items
      End If

      If Before > 0 Then
        Set FreeTime = Items.Add
        FreeTime.Subject = "Free Time"
        FreeTime.Start = DateAdd("n", -Before, Appt.Start)
        FreeTime.Duration = Before
        FreeTime.Save
      End If

      If After > 0 Then
        Set FreeTime = Items.Add
        FreeTime.Subject = "Free Time"
        FreeTime.Start = Appt.End
        FreeTime.Duration = After
        FreeTime.Save
      End If
    End If
  Next
End Sub

Private Function GetCurrentItems(Optional IsInspector As Boolean) As VBA.Collection
  Dim coll As VBA.Collection
  Dim Win As Object
  Dim Sel As Outlook.Selection
  Dim obj As Object
  Dim i&

  Set coll = New VBA.Collection
  Set Win = Application.ActiveWindow

  If TypeOf Win Is Outlook.Inspector Then
    IsInspector = True
    coll.Add Win.CurrentItem
  Else
    IsInspector = False
    Set Sel = Win.Selection
    If Not Sel Is Nothing Then
      For i = 1 To Sel.Count
        coll.Add Sel(i)
      Next
    End If
  End If
  Set GetCurrentItems = coll
End Function

Reply With Quote
  #2  
Old 07-09-2018, 04:53 PM
johnv johnv is offline Automatically Creating an Appointment Windows 10 Automatically Creating an Appointment Office 2016
Novice
 
Join Date: Jul 2018
Posts: 19
johnv is on a distinguished road
Default

Hi

you can try to use the event handler that fires when you send an item. Because when you accept a meeting you send an item. So you first check if it is a meeting request and if so you run your code.

like this

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)

If InStr(Item.MessageClass, "IPM.Schedule.Meeting.Request") > 0 Then
'do your thing here

end if
end sub
Reply With Quote
Reply

Tags
appointments, vba

Thread Tools
Display Modes


Similar Threads
Thread Thread Starter Forum Replies Last Post
Creating a shopping list, where dublicates are automatically added wasmabo Excel 7 01-10-2018 05:48 AM
Automatically Creating an Appointment My text is wrapping automatically creating a new page TheAnth Word 9 10-27-2017 05:53 PM
Automatically Creating an Appointment Problem creating table of contents automatically Badza.2020 Word 1 05-01-2015 04:58 PM
Automatically Creating an Appointment Have Excel automatically send an appointment to Outlook paulw793 Excel 1 09-12-2011 11:04 PM
Creating an Appointment as an other User (Impersonating) humpra Outlook 0 10-16-2009 03:36 AM


All times are GMT -7. The time now is 05:33 PM.


Powered by vBulletin® Version 3.8.11
Copyright ©2000 - 2019, vBulletin Solutions Inc.
Search Engine Optimisation provided by DragonByte SEO (Lite) - vBulletin Mods & Addons Copyright © 2019 DragonByte Technologies Ltd.
MSOfficeForums.com is not affiliated with Microsoft