Macro to set remindertime of contact to tomorrow 9:00

[Witzker]

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

[gmayor]

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.


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

[Witzker]

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).
22282
Hope for help again.

Regards
Witzker

[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

[gmayor]

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

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

[Witzker]

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

[gmayor]

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

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:

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.

Sub AddTenMinutes()
SetReminder 10, True
End Sub
You don't need the 'True' for hours.

[Witzker]

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

[gmayor]

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


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.

[Witzker]

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

[Witzker]

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??

[gmayor]

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.


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

[Witzker]

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

[gmayor]

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.


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

[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)

[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?

[Witzker]

Hi gmaijor

You gave me 2 Macros which I m using now.

1. set reminders using Minutes


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


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

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

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.