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