Sub createappt() Const olFolderCalendar = 9 Const olAppointmentItem = 1 Set objOutlook = CreateObject("Outlook.Application") Set objNamespace = objOutlook.GetNamespace("MAPI") Set Items = objNamespace.GetDefaultFolder(olFolderCalendar).Items Set objCalendar = objNamespace.GetDefaultFolder(olFolderCalendar) ' main calender Set objapt = objCalendar.Items.Add(olAppointmentItem) objapt.Subject = "Test" 'Owner 'objapt.Start = Date + TimeValue("08:00:00") ' Appt for 8AM objapt.Start = DateAdd("n", 60, Now) ' 60 Min from NOW 'Choose Duration OR End objapt.Duration = 60 * 1 'objapt.End = Date + TimeValue("16:00:00") objapt.Save End Sub
https://stackoverflow.com/questions/13713266/excel-create-an-outlook-calendar-event