Microsoft Office Forums - View Single Post - Can Outlook create other appointments from one entry?

gmayor · 12-28-2017, 08:08 AM

OK - based on the information you have provided, you need a macro something like the following. This prompts for the case details and a trial date and then creates the appointments. I have included the two deadlines for which you have supplied data. You will need to add the additional deadlines by copying the line to where it says 'etc

CreateAppointment strCase & " - Plaintiff Expert Witness Deadline", CStr(dStart - 120)

and changing the data in red to the type of deadline and the number of days before the trial as appropriate.

It could be made more sophisticated, but this will do the job.

Code:

Option Explicit

Sub CreateTrialAppointments()
Dim strDate As String
Dim dStart As Date
Dim iDelay As Integer
Dim strCase As String
    strCase = InputBox("Enter Case")
    strDate = InputBox("Enter Trial Date - 'mm/dd/yyyy'")
    If IsDate(strDate) Then
        dStart = CDate(strDate)
        CreateAppointment strCase & " - Trial Date", strDate
        
        CreateAppointment strCase & " - Plaintiff Expert Witness Deadline", CStr(dStart - 120)
        CreateAppointment strCase & " - Motions for Summary Judgment Deadline", CStr(dStart - 90)
        'etc
    End If
lbl_Exit:
    Exit Sub
End Sub

Private Sub CreateAppointment(strSubject As String, _
                      strDate As String)
Dim olItem As AppointmentItem
    Set olItem = CreateItem(olAppointmentItem)
    With olItem
        .MeetingStatus = olNonMeeting
        .Subject = strSubject
        .Start = strDate
        .AllDayEvent = True
        .Save
    End With
    Set olItem = Nothing
lbl_Exit:
    Exit Sub
End Sub