Add appointment to outlook calendar using MS access VBA

Automation to Add Appointments to Microsoft Outlook

This article is used to add appointments to Microsoft outlook through automation using VBA coding. We can set many appointments using the following procedure. First we have to create table with corresponding fields name as shown in Fig 1.1

Video player implementation using Access VBA Fig-1.1


Then create form based on table and add button on header section of form as shown in Fig 1.2. On button event procedure we have to write the code and to enabling the functionality of Microsoft outlook so for this we have to add Microsoft Outlook 14.0 object library by adding as reference.

Video player implementation using Access VBA Fig-1.2


After writing code on button event we have to open form in form view and click on button. After pressing on button we got a message as shown in Fig 1.3.

Video player implementation using Access VBA Fig-1.3


Then open the Microsoft outlook and check the appointment option in toolbar and click on it.We Can see the appointment is shown in detailed as shown in Fig 1.4

Video player implementation using Access VBA Fig-1.4


We can also open the calendar as shown in Fig 1.5 and check the details regarding appointments like as date, time, subject etc. all the things that we provided in Form.

Video player implementation using Access VBA Fig-1.5


VBA Coding to add appointment to outlook calendar:-

VBA code on button click event has been mentioned below.

Private Sub cmdAddAppt_Click()
On Error GoTo Add_Err
DoCmd.RunCommand acCmdSaveRecord
Dim olobj As Outlook.Application
Dim oloappt As Outlook.AppointmentItem
Dim reecurobj As Outlook.RecurrencePattern
Set olobj = CreateObject("Outlook.Application")
Set oloappt = olobj.CreateItem(olAppointmentItem)
With oloappt
.Start = Me!ApptDate & " " & Me!ApptTime
.Duration = Me!ApptLength
.Subject = Me!appt

If Not IsNull(Me!ApptNotes) Then .Body = Me!ApptNotes
If Not IsNull(Me!ApptLocation) Then .Location = Me!ApptLocation
If Me!ApptReminder Then
.ReminderMinutesBeforeStart = Me!ReminderMinutes
.ReminderSet = True
End If

Set reecurobj = .GetRecurrencePattern
With reecurobj
.RecurrenceType = olRecursWeekly
.Interval = 1
.PatternStartDate = CDate(Me.ApptDate)
.PatternEndDate = CDate(Me.ApptDate)
End With
.Close (olSave)
End With

Set oloappt = Nothing
Set olobj = Nothing
Me!AddedToOutlook = True
DoCmd.RunCommand acCmdSaveRecord
MsgBox "Appointment Added!"
Exit Sub
MsgBox "oops error found " & Err.Number & vbCrLf & Err.Description
Exit Sub
End Sub


It is advised that the information provided in the article should not be used for any kind formal or production programming purposes as content of the article may not be complete or well tested. ERP Makers will not be responsible for any kind of damage (monetary, time, personal or any other type) which may take place because of the usage of the content in the article.