The following macro and function will do that. You will have to add the button to the context sensitive Calendar ribbon. Remove the apostrophe from the start of the line where indicated after testing, (unless you want to add to the body of the appointment item)
Code:
Option Explicit
Sub CreateAppointment()
Dim strStartTime As String
Dim strEndTime As String
strStartTime = Format((Round(Now() * 48, 0) / 48), "hh:mm")
strEndTime = Format(DateAdd("n", 60, CDate(strStartTime)), "hh:mm")
AddOutlookApptmnt Date, Date, strStartTime, strEndTime, "Vehicle Inspection", "VIN:" & vbCr & vbCr & "Od:" & vbCr & vbCr & "Plate:"
lbl_Exit:
Exit Sub
End Sub
Private Sub AddOutlookApptmnt(sStartDate As String, _
sEndDate As String, _
sStartTime As String, _
sEndTime As String, _
sSubject As String, _
sBody As String, _
Optional sLocation As String)
Dim objAppt As Outlook.AppointmentItem
Dim objInsp As Outlook.Inspector
Dim objDoc As Object
Dim oRng As Object
Dim datStartDate As Date
Dim datEndDate As Date
Const BodyFont As String = "Arial"
Const BodySize As Long = 16
datStartDate = CDate(sStartDate & " " & sStartTime)
datEndDate = CDate(sEndDate & " " & sEndTime)
Set objAppt = CreateItem(1) 'appointment
With objAppt
.Start = datStartDate
.End = datEndDate
.ReminderSet = True
.AllDayEvent = False
.Subject = sSubject
.Location = sLocation
.Display
Set objInsp = objAppt.GetInspector
Set objDoc = objInsp.WordEditor
Set oRng = objDoc.Range(0, 0)
oRng.Text = sBody
oRng.Font.Name = BodyFont
oRng.Font.Size = BodySize
.BusyStatus = 0
'objInsp.Close 0 ' reinstate when you are happy with the result
End With
CancelledByUser: 'Error handler
If Err.Number > 0 Then
MsgBox "Cancelled By User", , "Operation Cancelled"
End If
Set objAppt = Nothing
Set objInsp = Nothing
Set objDoc = Nothing
Set oRng = Nothing
lbl_Exit:
Exit Sub
End Sub