Sub CreateTenAppts()
Dim i As Integer
Dim vDate As Variant
Dim sDate As String, sTime As String
Const sSubject As String = "Strategy Meeting" 'appointment subject
Const sLocation As String = "Conference Room" 'appointment location
Const sBody As String = "" 'The body text of the appointment
Const lMinutes As Integer = 60 'the length in minutes of the appointment

    sDate = InputBox("Enter start date 'mm/dd/yyyy' :")
    vDate = Split(sDate, "/")
    sTime = InputBox("Enter start time 'hh:mm' :")
    For i = 0 To 9
        sDate = CStr(vDate(0)) & "/" & CStr(Val(vDate(1) + i)) & "/" & CStr(vDate(2))
        CreateAppointment sSubject, sLocation, sBody, sDate, sTime, lMinutes, False
    Next i
lbl_Exit:
    Exit Sub
End Sub


Private Sub CreateAppointment(strSubject As String, _
                              strLocation As String, _
                              strBodyText As String, _
                              strDate As String, _
                              strTime As String, _
                              Optional iMinutes As Integer, _
                              Optional bAllDay As Boolean = True, _
                              Optional strName1 As String, _
                              Optional strName2 As String, _
                              Optional lngStatus As Long = olNonMeeting)

Dim olItem As AppointmentItem
Dim rRequiredAttendee As Recipient
Dim rOptionalAttendee As Recipient
Dim olInsp As Outlook.Inspector
Dim wdDoc As Object
Dim oRng As Object

    Set olItem = CreateItem(olAppointmentItem)
    With olItem
        .MeetingStatus = lngStatus
        .Subject = strSubject
        .Location = strLocation
        .Start = strDate & Chr(32) & strTime        ' & strAMPM
        .Duration = iMinutes
        .AllDayEvent = bAllDay
        'Set rRequiredAttendee = .Recipients.Add(strName1)
        'rRequiredAttendee.Type = olRequired
        'Set rOptionalAttendee = .Recipients.Add(strName2)
        'rOptionalAttendee.Type = olOptional
        .Display
        Set olInsp = .GetInspector
        Set wdDoc = olInsp.WordEditor
        Set oRng = wdDoc.Range
        oRng.Text = strBodyText
    End With
    olItem.Close olSave
    Set olItem = Nothing
    Set rRequiredAttendee = Nothing
    Set rOptionalAttendee = Nothing
    Set olInsp = Nothing
    Set wdDoc = Nothing
    Set oRng = Nothing
lbl_Exit:
    Exit Sub
End Sub