Create Outlook Event - VBA

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