Creating Outlook Calendar reminders from Excel spreadsheet

Topic

New Reply

Hello,
I need assistance in adding function to create a reminder in Outlook from an Excel spreadsheet.

I have a spreadsheet with list of employees and their respective trained dates for various certificates. Each certificate has an expiring date, or date needing to retrain. In order to help keep track of when employees need to retrain, I’d like to set the sheet up to where it will auto apply reminders in Outlook Calendar and remind me when retraining for each employee is 30 days away.

See attached for sample spreadsheet.

I want to set up reminder for 30 days prior to each date in the ‘Recert Date’ column for each employee.

Thanks

Reply | Quote

Replies

JBegnaud,

If the recert date is blank, do you want a reminder or just skip it?

Maud

Reply | Quote

JBegnaud,

If the recert date is blank, do you want a reminder or just skip it?

Maud

Skip the blanks.

Thanks

Reply | Quote

bump

Reply | Quote

No need to bump, Maude is on the case.

cheers, Paul

Reply | Quote

Paul, you are too funny!

JB, I’ll have something for you soon!

Maud

Reply | Quote

JB,

Here is your revised file that will create Outlook reminders 30 days out for all recert dates that are not blank or expired. Click on the Create Reminders button (not shown in image). The code will check to see if outlook is running. The code will then cycle through the Recert Columns. If the cell meets the criteria above, it will add a cell comment stating the date the reminder was created as well as adding the reminder to Outlook (see images). The reminders will include the employee and the recert date.

Let me know in this meets your needs.

Maud

39001-Training-Matrix

39002-Training-Matrix2

Code:

Dim StartedOutlook As Boolean
 
Public Sub CreateReminder()
[COLOR=”#008000″]’——————————————-
‘CREATE AND SET VARIABLES[/COLOR]
Dim LastRow As Long
[COLOR=”#008000″]’——————————————-
‘VALIDATE RECERT COLUMN HAS FUTURE DATE WITH NO COMMENT[/COLOR]
For I = 10 To 85
    If Cells(4, I) = “Recert Date” Then
        LastRow = ActiveSheet.Cells(Rows.Count, I).End(xlUp).row
        For J = 6 To 21[COLOR=”#008000″] ‘CHANGE TO ROW OF LAST EMPLOYEE[/COLOR]
            If IsDate(Cells(J, I)) Then
                If Cells(J, I) > Date And Cells(J, I).Comment Is Nothing Then
[COLOR=”#008000″]’——————————————-
‘ADD COMMENT AND CALL ROUTINE TO CREATE REMINDER[/COLOR]
                    Cells(J, I).AddComment
                    Cells(J, I).Comment.Text Text:=”Reminder Added ” & Date
                    AddToTasks Cells(J, I), Cells(2, I – 1), J, -30
                End If
            End If
        Next J
    End If
Next I
End Sub

Public Sub AddToTasks(RecertDate As Date, strText As String, ByVal emp As Long, DaysOut As Integer)
[COLOR=”#008000″]’——————————————–
‘CREATE AND SET VARIABLES[/COLOR]
Dim intDaysBack As Integer
Dim dteDate As Date
Dim olApp As Object ‘ Outlook.Application
Dim objTask As Object ‘ Outlook.TaskItem
[COLOR=”#008000″]’——————————————–
‘CALCULATE TASK REMINDER DATE[/COLOR]
intDaysBack = DaysOut – (DaysOut * 2)
RemDate = RecertDate + DaysOut ‘intDaysBack
On Error Resume Next
  Set olApp = GetOutlookApp
On Error GoTo 0
[COLOR=”#008000″]’——————————————–
‘CREATE TASK ITEM[/COLOR]
client = “Employee: ” & Cells(emp, 1) & Chr(13) & strText & “Recertification”
If Not olApp Is Nothing Then
  Set objTask = olApp.createitem(3)  ‘ task item
  With objTask
    .StartDate = RemDate
    .Subject = strText & “, due on: ” & RecertDate
    .reminderset = True
    .Body = client
    .Save
  End With
Else
  GoTo ExitProc
End If
[COLOR=”#008000″]’——————————————
‘CLEAN-UP[/COLOR]
ExitProc:
If StartedOutlook Then
  olApp.Quit
End If
Set olApp = Nothing
Set objTask = Nothing
End Sub


Function GetOutlookApp() As Object
[COLOR=”#008000″]’TEST IF OUTLOOK IS RUNNING[/COLOR]
On Error Resume Next
  Set GetOutlookApp = GetObject(, “Outlook.Application”)
  If Err.Number  0 Then
    Set GetOutlookApp = CreateObject(“Outlook.Application”)
    StartedOutlook = True
  End If
On Error GoTo 0
 
End Function

Reply | Quote

Although totally functional as is, if I were to rewrite the code the changes that I would make would be:
1. Currently, the code will cycle through all the recert columns and create a reminder for all dates that meet the criteria. This will put a list of 30 – 40 reminders in Outlook. I would adjust one line of code to 2 lines of code so that 45 days prior to the recert it creates the reminder that will alert the user 30 days prior to expiration (15 days from that point).

From (remove line in blue):

Code:

[COLOR=”#008000″]’——————————————-
‘VALIDATE RECERT COLUMN HAS FUTURE DATE WITH NO COMMENT[/COLOR]
For I = 10 To 85
    If Cells(4, I) = “Recert Date” Then
        LastRow = ActiveSheet.Cells(Rows.Count, I).End(xlUp).row
        For J = 6 To 21 ‘CHANGE TO ROW OF LAST EMPLOYEE
            If IsDate(Cells(J, I)) Then
                [COLOR=”#0000FF”]If Cells(J, I) > Date And Cells(J, I).Comment Is Nothing Then[/COLOR]
[COLOR=”#008000″]’——————————————-
‘ADD COMMENT AND CALL ROUTINE TO CREATE REMINDER[/COLOR]
                    Cells(J, I).AddComment
                    Cells(J, I).Comment.Text Text:=”Reminder Added ” & Date
                    AddToTasks Cells(J, I), Cells(2, I – 1), J, -30
                End If
            End If
        Next J
    End If
Next I
End Sub

To (add lines in blue):

Code:

[COLOR=”#008000″]’——————————————-
‘VALIDATE RECERT COLUMN HAS FUTURE DATE 30 TO 45 FROM TODAY WITH NO CELL COMMENT[/COLOR]
For I = 10 To 85
    If Cells(4, I) = “Recert Date” Then
        LastRow = ActiveSheet.Cells(Rows.Count, I).End(xlUp).row
        For J = 6 To 21 ‘CHANGE TO ROW OF LAST EMPLOYEE
            If IsDate(Cells(J, I)) Then
[COLOR=”#0000FF”]                Period = Cells(J, I) – Date
                If Period = 30 And Cells(J, I).Comment Is Nothing Then[/COLOR]
[COLOR=”#008000″]’——————————————-
‘ADD COMMENT AND CALL ROUTINE TO CREATE REMINDER[/COLOR]
                    Cells(J, I).AddComment
                    Cells(J, I).Comment.Text Text:=”Reminder Added ” & Date
                    AddToTasks Cells(J, I), Cells(2, I – 1), J, -30
                End If
            End If
        Next J
    End If
Next I
End Sub

2. I would have the code initiated each time the workbook is opened by using the Workbook_Open event assuming that the workbook is opened regularly. Outlook would only have reminders created within a certain time frame and not all reminders created up front.

3. When the recert date meets the criteria to have a reminder created, it runs the AddToTasks routine which checks each time to see if Outlook is open. Since the code cycles through all the dates at one time it really only need to check Outlook only once. I would Take it out of the AddToTasks subroutine and place the validation in the beginning of the CreateReminder routine. Although it will make no difference to leave as is, it would be better coding.

Maud

Reply | Quote