Macro to set remindertime of contact to tomorrow 9:00

Hi
I need a macro in the ribbon of an Outlook 2010 contact to ser the remindedate to call the contact tomorrow at 9:00 in the morning

Hope for help
Regards
Witzker

The following will add a task to remind you to call the selected contact tomorrow at 0900. Add the macro to the ribbon as required.

Code:

---

Option Explicit
'Graham Mayor - http://www.gmayor.com - Last updated - 19 May 2018
Sub AddReminderToContact()
Dim olContact As ContactItem
    On Error GoTo err_Handler:
    Set olContact = ActiveExplorer.Selection.Item(1)
    AddOlTask "Telephone Contact", _
              olContact.FullName & vbCr & _
              olContact.BusinessTelephoneNumber, _
              Date + 1, Date + 1 & " 09:00"
lbl_Exit:
    Set olContact = Nothing
    Exit Sub
err_Handler:
    Beep
    Err.Clear
    GoTo lbl_Exit
End Sub


Private Sub AddOlTask(sSubject As String, sBody As String, _
              dtDueDate As Date, _
              dtReminderDate As Date, _
              Optional iStatus As Integer = 0, _
              Optional iImportance As Integer = 1)
Dim olTask As TaskItem

    On Error GoTo Error_Handler
    Set olTask = CreateItem(3)

    With olTask
        .Subject = sSubject
        .DueDate = dtDueDate
        .Status = iStatus        '0=not started, 1=in progress, 2=complete, 3=waiting, 4=deferred
        .Importance = iImportance        '0=low, 1=normal, 2=high
        .ReminderSet = True
        .ReminderTime = dtReminderDate
        .Categories = "Business"        'use any of the predefined Categories or create your own
        .Body = sBody
        .Display
        .Save
        .Close 0
    End With

lbl_Exit:
    Set olTask = Nothing
    Exit Sub

Error_Handler:
    Beep
    MsgBox "The following error has occured" & vbCrLf & vbCrLf & "Error Number: " & _
          Err.Number & vbCrLf & "Error Source: AddOlkTask" & vbCrLf & "Error Description: " & _
          Err.Description, vbCritical, "An Error has Occured!"
    Err.Clear
    GoTo lbl_Exit:
End Sub

---

Wow Thanks,

I think I found the right forum.

This is surely an approach but for my demand it would be better to have the marked contacts (reminder time) in a list view.

I have a few views with different criteria on a lot of contacts.

I have to do as many calls per day as possible but the people are very hard to get on the phone.
So I have to call again later the day or next day or I get a rough time to call again.

What I do at the moment is in the contact form is manually chose a reminder date with drop down and a reminder time in the drop down and have to scroll to the next possible time.

What I would need is to have this now manual procedure in more macros which I will put on the ribbon.
e.g. today + 2 hours, today 14.00 o'clock, tomorrow 09.00 o'clock
The marked items are getting red in the view when reminder time is in the past, so I can change the criteria view and find the red contacts easy to chose and call them.

Many thanks for the task solution above.

I hope to get a code that can do the same like I do manually now (set reminder time of a contact).
Attachment 22282
Hope for help again.

Regards
Witzker

Hi
No proggress!
can you pls. be so kind and recomand another Forum for my request

Anscheinen gehts hier nicht weiter!
Könnt Ihr mir bitte für meine Frage ein spezielles Forum nennen?

Danke
LG Witzker

I missed your earlier reply. From your description, I think the following may be what you require.

Code:

---

Sub AddHour()   
    SetReminder 1
End Sub


Sub AddTwoHours()
    SetReminder 2
End Sub


Public Sub SetReminder(dHours As Double)
Dim olItem As Object
Dim dTime As Date
    Select Case TypeName(Application.ActiveWindow)
        Case "Explorer"
            Set olItem = ActiveExplorer.Selection.Item(1)
        Case "Inspector"
            Set olItem = ActiveInspector.currentItem
    End Select


    If TypeName(olItem) = "ContactItem" Then
        dTime = CDate(Now)
        dTime = DateAdd("h", dHours, dTime)
        With olItem
            .MarkAsTask olMarkNoDate
            .ReminderSet = True
            .ReminderTime = dTime
            .Save
        End With
    End If
    Set olItem = Nothing
End Sub

---

Great THX
I coppied all in Modul 2
With the line Public Sub SetReminder(dHours As Double)
the macro was not visible in macros so I changed to
Public Sub SetReminder()

works but
When I click the makro reminder is set to Now.
When I close OL and open it 3 min later the contact in the contact list is not marked red like others with expired Reminder
can you help pls

It doesn't work like that - put it back as it was originally posted. The supplementary macros provide the delay.
Run the macro AddHour to remind you in an hour i.e.
SetReminder 1
or AddTwoHours to remind you in two hours
SetReminder 2
or for a variable number of hours

Code:

---

Sub AddHours()
Dim dHrs As Double
    dHrs = InputBox("Enter the number of hours to reminder", "Reminder", 2)
    SetReminder dHrs
End Sub

---

You may wish to add minutes rather than hours so alter the main code to the following which will work for both:

Code:

---

Public Sub SetReminder(dHours As Double, Optional bMin As Boolean)
Dim olItem As Object
Dim dTime As Date
    Select Case TypeName(Application.ActiveWindow)
        Case "Explorer"
            Set olItem = ActiveExplorer.Selection.Item(1)
        Case "Inspector"
            Set olItem = ActiveInspector.currentItem
    End Select


    If TypeName(olItem) = "ContactItem" Then
        dTime = CDate(Now)
        If bMin = True Then
            dTime = DateAdd("n", dHours, dTime)
        Else
            dTime = DateAdd("h", dHours, dTime)
        End If
        With olItem
            .MarkAsTask olMarkNoDate
            .ReminderSet = True
            .ReminderTime = dTime
            .Save
        End With
    End If
    Set olItem = Nothing
End Sub

---

and call it as follows e.g.

Code:

---

Sub AddTenMinutes()
    SetReminder 10, True
End Sub

---

You don't need the 'True' for hours.

Many THX

as you see Im not clever with VBA but try to learn
after your explaination I understand the princip - THX

I click the makro with minutes set to 3 min - tme & reminder set OK

When I close OL and open it 5 min later the contact in the contact list is still not marked red like others with expired reminder
can you help again pls

Are you sure you set the time to three minutes and not three hours? Have you checked the reminder on the contact?

Code:

---

Sub AddThreeMinutes()   
    SetReminder 3, True
End Sub

---

On restarting Outlook you should get a reminder pop up when you next start Outlook (after three minutes). Because of the way Outlook works, you may have to wait a few seconds for the reminder to appear. It does however appear if you have copied the code correctly.

THX for taking care

The macro works fine so far

the problem is that I have a lot of contacts they are hard to reach so I set reminders for eg Tomorrow 9:00 ( that would also be my question how to do this with macro)

So I have a lot of reminders.
I group them in a view list.
Now I have to see with ones are due.

When I set reminders in OL the are marked RED in the view list when due.
When I set reminders With the macro the are NOT marked RED in the view list when due.

I try to send screenshots

Here you see the tests.

Mark contact 1 with macro 2. With OL


I close Ol and open it Again when they are due


The reminders Popup correctly


But in List view The contact set with macro is not RED, so I cannot see which one is due


I think there is something more to be set in the macro

THX for help

Sorry the screenshots are denied by forum??

I have tested and it appears that the red marking of the contacts in the list is a bit hit and miss, however the following sets the flag the same as the dialog. so it may work better for you. If not I regret I don't know how to ensure that the red emphasis is displayed.

Code:

---

Public Sub SetReminder(dHours As Double, _                      Optional bMin As Boolean, _
                      Optional lngDue As Long = 0)


'Set lngDue as follows from the calling macro. The default is 0
'0 = olMarkToday
'1 = olMarkTomorrow
'2 = olMarkThisWeek


Dim olItem As Object
Dim dTime As Date
    Select Case TypeName(Application.ActiveWindow)
        Case "Explorer"
            Set olItem = ActiveExplorer.Selection.Item(1)
        Case "Inspector"
            Set olItem = ActiveInspector.currentItem
    End Select


    If TypeName(olItem) = "ContactItem" Then
        dTime = CDate(Now)
        If bMin = True Then
            dTime = DateAdd("n", dHours, dTime)
        Else
            dTime = DateAdd("h", dHours, dTime)
        End If
        With olItem
            .MarkAsTask lngDue
            .ReminderSet = True
            .ReminderTime = dTime
            .Save
        End With
    End If
    Set olItem = Nothing
End Sub


Sub AddTwoMinutes()
    SetReminder 2, True, 0
End Sub

---

THX I will test it later.

I would like to ask You anyway for a code to set reminder to tomorrow ( 1 (or 2)day(s) later) at 9:00 or 14:00
many THX for taking care

You will need a different set of codes for that - essentially similar but not so easy to do in one macro that is easy to follow.

Code:

---

Sub TomorrowAtNine()   
    SetReminderTomorrowOrNextDay 1, False
End Sub


Sub TomorrowAtTwo()
    SetReminderTomorrowOrNextDay 1, True
End Sub


Sub DayAfterAtNine()
    SetReminderTomorrowOrNextDay 2, False
End Sub


Sub DayAfterAtTwo()
    SetReminderTomorrowOrNextDay 2, True
End Sub




Public Sub SetReminderTomorrowOrNextDay(iDays As Integer, _
                                        bPM As Boolean)




'Set lngDue as follows from the calling macro. The default is 0
'0 = olMarkToday
'1 = olMarkTomorrow
'2 = olMarkThisWeek




Dim olItem As ContactItem
Dim dTime As Date
    Select Case TypeName(Application.ActiveWindow)
        Case "Explorer"
            Set olItem = ActiveExplorer.Selection.Item(1)
        Case "Inspector"
            Set olItem = ActiveInspector.currentItem
    End Select




    If TypeName(olItem) = "ContactItem" Then
        dTime = CDate(Date + iDays)
        If bPM = True Then
            dTime = dTime & " 14:00:00"
        Else
            dTime = dTime & " 09:00:00"
        End If


        With olItem
            If iDays = 1 Then
                .MarkAsTask 1
            Else
                .MarkAsTask 2
            End If
            .TaskStartDate = dTime
            .TaskDueDate = dTime
            .ReminderSet = True
            .ReminderTime = dTime
            .Save
        End With
    End If
    Set olItem = Nothing
End Sub

---

THX

As reminder works and time is set correctely mayby it is an approach to edit the View list with this settings in attachment

The problem is that I cannot find an Option for reminder (Erinnerungszeit) is due
There is only - today or older - no time!

Is there a way to set this in vba

eg. if Rimindertime is due

Font = red? (fontsetting is possible)

Quote:

---

Originally Posted by Witzker

THX

As reminder works and time is set correctely mayby it is an approach to edit the View list with this settings in attachment

The problem is that I cannot find an Option for reminder (Erinnerungszeit) is due
There is only - today or older - no time!

Is there a way to set this in vba

eg. if Rimindertime is due

Font = red? (fontsetting is possible)

---

any news?

Hi gmaijor

You gave me 2 Macros which I m using now.

1. set reminders using Minutes

Code:

---

Sub Add10Minutes() 'ruft Sub SetReminder(dHours As Double, Optional bMin As Boolean, Optional lngDue As Long = 0)auf
    SetReminder 10, True, 0
End Sub
Sub Add60Minutes() 'ruft Sub SetReminder(dHours As Double, Optional bMin As Boolean, Optional lngDue As Long = 0)auf
    SetReminder 60, True, 0
End Sub

Public Sub SetReminder(dHours As Double, Optional bMin As Boolean, Optional lngDue As Long = 0)


'Set lngDue as follows from the calling macro. The default is 0
'0 = olMarkToday
'1 = olMarkTomorrow
'2 = olMarkThisWeek


Dim olItem As Object
Dim dTime As Date
    Select Case TypeName(Application.ActiveWindow)
        Case "Explorer"
            Set olItem = ActiveExplorer.Selection.Item(1)
        Case "Inspector"
            Set olItem = ActiveInspector.CurrentItem
    End Select


    If TypeName(olItem) = "ContactItem" Then
        dTime = CDate(Now)
        If bMin = True Then
            dTime = DateAdd("n", dHours, dTime)
        Else
            dTime = DateAdd("h", dHours, dTime)
        End If
        With olItem
            .MarkAsTask lngDue
            .ReminderSet = True
            .ReminderTime = dTime
            .Save
        End With
    End If
    Set olItem = Nothing
End Sub

---

and
2. set reminder using Days

Code:

---

Sub Heute14()
    SetReminderTomorrowOrNextDay 0, True
End Sub
Sub Morgen09()
    SetReminderTomorrowOrNextDay 1, False
End Sub
Sub Morgen14()
    SetReminderTomorrowOrNextDay 1, True
End Sub
Sub in2Tag09()
    SetReminderTomorrowOrNextDay 2, False
End Sub
Sub in2Tag14()
    SetReminderTomorrowOrNextDay 2, True
End Sub
Sub in3Tag09()
    SetReminderTomorrowOrNextDay 3, False
End Sub
Sub in3Tag14()
    SetReminderTomorrowOrNextDay 3, True
End Sub
Sub in7Tag09()
    SetReminderTomorrowOrNextDay 7, False
End Sub


Public Sub SetReminderTomorrowOrNextDay(iDays As Integer, _
                                        bPM As Boolean)


'Set lngDue as follows from the calling macro. The default is 0
'0 = olMarkToday
'1 = olMarkTomorrow
'2 = olMarkThisWeek




Dim olItem As ContactItem
Dim dTime As Date
    Select Case TypeName(Application.ActiveWindow)
        Case "Explorer"
            Set olItem = ActiveExplorer.Selection.Item(1)
        Case "Inspector"
            Set olItem = ActiveInspector.CurrentItem
    End Select




    If TypeName(olItem) = "ContactItem" Then
        dTime = CDate(Date + iDays)
        If bPM = True Then
            dTime = dTime & " 14:00:00"
        Else
            dTime = dTime & " 09:00:00"
        End If


        With olItem
            If iDays = 1 Then
                .MarkAsTask 1
            Else
                .MarkAsTask 2
            End If
            '.TaskStartDate = dTime
            '.TaskDueDate = dTime
            .ReminderSet = True
            .ReminderTime = dTime
            .Save
        End With
    End If
    Set olItem = Nothing
End Sub

---

I found following problem when using it

in the reminder window of outlook the macro
with minutes also has
.TaskStartDate = dTime
.TaskDueDate = dTime

Attachment 25864

This is not good for showing the reminder in Outlook reminder window.

My question would be if you could be so kind and remove
.TaskStartDate = dTime
.TaskDueDate = dTime

from all macros so that only reminder time is set

Attachment 25865

I do not understand how to change the macro I tried
'.TaskStartDate = dTime
'.TaskDueDate = dTime

But when I click the 7 Days it has no effect

In the macro1 with minutes I have not found start and due date

Hope you can help me again.