Scheduling Appointments in Outlook From Excel

1. Some things are too good not to share

2. This is one of them

3. How about if I show you how to take rows in Excel and make them appointments in Outlook?

4. Well then, you must read on

Outlook appointments

1. Managing your calendar is a critical success factor at almost any company

2. If I can automate anything I will spend the time to do it

3. This utility has served me well over the years

   

   Figure 1: Excel to Outlook

IT IS SOME SIMPLE VBA CODE

1. It is a simple question of taking cells in Excel and making them properties in an Outlook appointment

2. Just write a loop in VBA and go through all the rows in Excel and writes appointments in Excel

HERE IS WHAT THE CODE LOOKS LIKE

1. There are endless possibilities here

   • You could invite attendees
   • You could add attachments

Excel VBA

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54

Sub RegisterAppointmentList()     ' adds a list of appontments to the Calendar in Outlook     Dim olApp As Outlook.Application     Dim olAppItem As Outlook.AppointmentItem     Dim r As Long         On Error Resume Next     Worksheets("Schedule").Activate     Set olApp = GetObject("", "Outlook.Application")     On Error GoTo 0     If olApp Is Nothing Then         On Error Resume Next         Set olApp = CreateObject("Outlook.Application")         On Error GoTo 0         If olApp Is Nothing Then             MsgBox "Outlook is not available!"             Exit Sub         End If     End If     r = 6 ' first row with appointment data in the active worksheet     Dim mysub, myStart, myEnd     While Len(Cells(r, 2).Text) <> 0         mysub = Cells(r, 2) & ", " & Cells(r, 3)         myStart = DateValue(Cells(r, 5).Value) + Cells(r, 6).Value         myEnd = DateValue(Cells(r, 5).Value) + Cells(r, 7).Value         'DeleteTestAppointments mysub, myStart, myEnd         Set olAppItem = olApp.CreateItem(olAppointmentItem) ' creates a new appointment         With olAppItem             ' set default appointment values             .Location = Cells(r, 3)             .Body = ""             .ReminderSet = True             .BusyStatus = olFree             '.RequiredAttendees = "johndoe\@microsoft.com"             On Error Resume Next             .Start = myStart             .End = myEnd             .Subject = Cells(r, 2) & ", " & .Location             .Attachments.Add ("c:\temp\somefile.msg")             .Location = Cells(r, 3).Value             .Body = .Subject & ", " & Cells(r, 4).Value             .ReminderSet = True             .BusyStatus = olBusy             .Categories = "Orange Category" ' add this to be able to delete the testappointments             On Error GoTo 0             .Save ' saves the new appointment to the default folder         End With         r = r + 1     Wend     Set olAppItem = Nothing     Set olApp = Nothing     MsgBox "Done !" End Sub

Comments

• Anonymous
  January 17, 2015
  Is it possible to have this code run for the current row only?  For my purpose, I'd like to enter in my data and then click a button on the toolbar to add the current row (only) to outlook. Thanks

• Anonymous
  June 16, 2015
  This is much better than the many examples I found so far, over a week of searching! Thank you :-)

• Anonymous
  June 17, 2015
  Can you please post example  workbook?

• Anonymous
  July 09, 2015
  is it possible to create same for LYNC online meeting

• Anonymous
  August 26, 2015
  This has proved really useful to a non-VBA competent novice like me. I'm trying to run the macro on existing data and for it only to pick up 'new' rows that I've added since last running the macro. What can I add to the code to check for duplicates to prevent further diary invitations going out? Thanks! Stuart

• Anonymous
  December 10, 2015
  Very useful and helpful. Thank you.