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
Printable View
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
You may wish to add minutes rather than hours so alter the main code to the following which will work for both:Code:Sub AddHours()
Dim dHrs As Double
dHrs = InputBox("Enter the number of hours to reminder", "Reminder", 2)
SetReminder dHrs
End Sub
and call it as follows e.g.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
You don't need the 'True' for hours.Code:Sub AddTenMinutes()
SetReminder 10, True
End Sub
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?
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.Code:Sub AddThreeMinutes()
SetReminder 3, True
End Sub
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)
Hi gmaijor
You gave me 2 Macros which I m using now.
1. set reminders using Minutes
andCode: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
2. set reminder using Days
I found following problem when using itCode: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
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.