SearchBox Week, Day 3

Welcome back! Today the search term I've chosen is "change reminder date on task VBA". What I'll do is provide some Excel VBA code to allow you to alter a reminder date for an existing task in your Outlook Tasks list. The code also works as a UDF — the cell will change to TRUE if the task was updated, and FALSE if it fails.

And let me say the number of duplicate and repeat searches is staggering. There are so many people searching for "outlook vba" or "excel vba", I must say it's mindblowing how many generic searches there are

For reference: TaskItem Object

First we'll start with a generic sub that returns a reference to the Outlook.Application Object (I took the code from Using Excel VBA to set up Task Reminders in Outlook):

Function GetOutlookApp() As Object
On Error Resume Next
  Set GetOutlookApp = GetObject(, "Outlook.Application")
  If Err.Number <> 0 Then
	Set GetOutlookApp = CreateObject("Outlook.Application")
	bWeStartedOutlook = True
  End If
On Error GoTo 0
End Function

The sub that does most of the work is below. It accepts two arguments: A string that consists of the task's full subject, and the new reminder date for the task. It's important that you remove the function after each use (either by pasting in the cell's value, or simply selecting the cell and pressing the Delete key), because each time the worksheet recalculates, the function will re-run. This will cause noticeable slowdown and useless overhead if (for example) you list a set of task subject names in a column, and fill down the ChangeTaskReminderDate formula.

Function ChangeTaskReminderDate(strName As String, dteDate As Date) As Boolean
Dim olApp As Object
Dim olNS As Object
Dim olItems As Object
Dim olItemToChange As Object

' don't change reminder date to the past
If dteDate < Now Then
  ChangeTaskReminderDate = False
  GoTo ExitProc
End If

On Error Resume Next
  Set olApp = GetOutlookApp
On Error GoTo 0

If Not olApp Is Nothing Then
  Set olNS = olApp.GetNamespace("MAPI")
  Set olItems = olNS.GetDefaultFolder(13).Items ' olFolderTasks is value 13
  Set olItemToChange = olItems.Find("[Subject] = " & strName)
  'or use: Set olItemToChange = olItems.Item(strName)

  If olItemToChange Is Nothing Then
    ChangeTaskReminderDate = False
    GoTo ExitProc
  End If

  With olItemToChange
  ' if the reminder date and due date are the same, change both,
  ' else just change the reminder date
    If .ReminderTime = .DueDate Then
      .ReminderTime = dteDate
      .DueDate = dteDate
    Else
      .ReminderTime = dteDate
    End If
    .Save
  End With
  ChangeTaskReminderDate = True
Else
  ChangeTaskReminderDate = False
  GoTo ExitProc
End If

ExitProc:
If bWeStartedOutlook Then
  olApp.Quit
End If
Set olApp = Nothing
Set olNS = Nothing
End Function

Here is the entire code, which should be pasted into a standard Excel module. A module-level Boolean variable is used to tell the main sub whether to quit Outlook.

Dim bWeStartedOutlook As Boolean

Function ChangeTaskReminderDate(strName As String, dteDate As Date) As Boolean
' - updates reminder date for an Outlook task
' - if the reminder date and due date are the same, the function updates both
' - works with Outlook open or closed
' - will not set reminders to past
' by Jimmy Pena, http://www.jpsoftwaretech.com/, 12/17/2008
'
' Usage (VBA):
' Dim success As Boolean
' success = ChangeTaskReminderDate("My Task Subject", "12/21/2008")
' Usage (UDF):
' =ChangeTaskReminderDate("My Task Subject", "12/21/2008")
' or
' =ChangeTaskReminderDate(A2, B2)
' where A2 contains the task's subject, and B2 contains a valid date
'
Dim olApp As Object
Dim olNS As Object
Dim olItems As Object
Dim olItemToChange As Object

' don't change reminder date to the past
If dteDate < Now Then
  ChangeTaskReminderDate = False
  GoTo ExitProc
End If

On Error Resume Next
  Set olApp = GetOutlookApp
On Error GoTo 0

If Not olApp Is Nothing Then
  Set olNS = olApp.GetNamespace("MAPI")
  Set olItems = olNS.GetDefaultFolder(13).Items ' olFolderTasks is value 13
  Set olItemToChange = olItems.Find("[Subject] = " & strName)
  'or use: Set olItemToChange = olItems.Item(strName)

  If olItemToChange Is Nothing Then
    ChangeTaskReminderDate = False
    GoTo ExitProc
  End If

  With olItemToChange
  ' if the reminder date and due date are the same, change both,
  ' else just change the reminder date
    If .ReminderTime = .DueDate Then
      .ReminderTime = dteDate
      .DueDate = dteDate
    Else
      .ReminderTime = dteDate
    End If
    .Save
  End With
  ChangeTaskReminderDate = True
Else
  ChangeTaskReminderDate = False
  GoTo ExitProc
End If

ExitProc:
If bWeStartedOutlook Then
  olApp.Quit
End If
Set olApp = Nothing
Set olNS = Nothing
End Function

Function GetOutlookApp() As Object
On Error Resume Next
  Set GetOutlookApp = GetObject(, "Outlook.Application")
  If Err.Number <> 0 Then
  Set GetOutlookApp = CreateObject("Outlook.Application")
  bWeStartedOutlook = True
  End If
On Error GoTo 0
End Function

To test out the sub, you can use a routine like this:

Sub TestUpdate()
Dim success As Boolean
success = ChangeTaskReminderDate("My Task Subject", "12/21/2008")
MsgBox success
End Sub

Let me know if you test it out, find any bugs, etc.

Related Articles:

• December 29, 2008 -- Update Outlook Task Reminder Dates from Excel
• November 2, 2008 -- Using Excel VBA to set up Task Reminders in Outlook