Outlook VBA Macro (Task Firing)
'Macro Begins Here
Public WithEvents olkInbox As Outlook.Items
Private Sub Application_Quit()
Set olkInbox = Nothing
End Sub
Private Sub Application_Startup()
Set olkInbox = Application.GetNamespace("
End Sub
Function IsNothing(objItem As Object)
' Purpose: Tests to see if an object is not set to any value.'
' Outlook: All versions'
IsNothing = (TypeName(objItem) = "Nothing")
End Function
Private Sub OlkInbox_ItemAdd(ByVal Item As Object)
If Item.Class = olMail Then
'Change Text within " " below this comment to the subject text you want to key on
If InStr(1, Item.Subject, "Daily 3M") Then
'Change + 24 to the number of hours you want to wait for the next message to arrive
ManageWatcherTask Now + 1
Item.UnRead = False
Item.Save
End If
End If
End Sub
Sub ManageWatcherTask(datDateD
Dim olkTaskFolder As Outlook.Items
Dim olkTask As Outlook.TaskItem
Set olkTaskFolder = Application.GetNamespace("
'Change Subject below to whatever task name you want to use.
olkTast = olkTaskFolder.Find("[Subje
If Not IsNothing(olkTask) Then
olkTask.ReminderTime = datDateDue
olkTask.ReminderSet = True
Else
Set olkTask = Application.CreateItem(olT
With olkTask
.DueDate = datDateDue
'Make sure subject below matches the Subject above
.Subject = "Daily 3M Report"
.ReminderTime = datDateDue
.ReminderSet = True
End With
End If
olkTask.Save
Set olkTask = Nothing
'Macro ends here
End Sub
--------------------------
Okay, so the above VBA code is suppose to check daily for an email with Daily 3M in the subject. If an email is detected by 8:00AM with Daily 3M in the subject, it's suppose to stop the task from firing and setting a new task for 24 hours in advance. It will continue to do this until an email that you're suppose to receive does not arrive on time which triggers a Task Reminder.
It does everything I want it to do except stopping the current days task reminder. It sets the next days task reminder when the email is received, however the current day will still trigger at the time it's suppose to trigger that day, but it's not suppose to because they got an email with Daily 3M in the title.
Can someone please take a look and see what we can do to fix this and keep the current days task from firing if an email is received?
Public WithEvents olkInbox As Outlook.Items
Private Sub Application_Quit()
Set olkInbox = Nothing
End Sub
Private Sub Application_Startup()
Set olkInbox = Application.GetNamespace("
End Sub
Function IsNothing(objItem As Object)
' Purpose: Tests to see if an object is not set to any value.'
' Outlook: All versions'
IsNothing = (TypeName(objItem) = "Nothing")
End Function
Private Sub OlkInbox_ItemAdd(ByVal Item As Object)
If Item.Class = olMail Then
'Change Text within " " below this comment to the subject text you want to key on
If InStr(1, Item.Subject, "Daily 3M") Then
'Change + 24 to the number of hours you want to wait for the next message to arrive
ManageWatcherTask Now + 1
Item.UnRead = False
Item.Save
End If
End If
End Sub
Sub ManageWatcherTask(datDateD
Dim olkTaskFolder As Outlook.Items
Dim olkTask As Outlook.TaskItem
Set olkTaskFolder = Application.GetNamespace("
'Change Subject below to whatever task name you want to use.
olkTast = olkTaskFolder.Find("[Subje
If Not IsNothing(olkTask) Then
olkTask.ReminderTime = datDateDue
olkTask.ReminderSet = True
Else
Set olkTask = Application.CreateItem(olT
With olkTask
.DueDate = datDateDue
'Make sure subject below matches the Subject above
.Subject = "Daily 3M Report"
.ReminderTime = datDateDue
.ReminderSet = True
End With
End If
olkTask.Save
Set olkTask = Nothing
'Macro ends here
End Sub
--------------------------
Okay, so the above VBA code is suppose to check daily for an email with Daily 3M in the subject. If an email is detected by 8:00AM with Daily 3M in the subject, it's suppose to stop the task from firing and setting a new task for 24 hours in advance. It will continue to do this until an email that you're suppose to receive does not arrive on time which triggers a Task Reminder.
It does everything I want it to do except stopping the current days task reminder. It sets the next days task reminder when the email is received, however the current day will still trigger at the time it's suppose to trigger that day, but it's not suppose to because they got an email with Daily 3M in the title.
Can someone please take a look and see what we can do to fix this and keep the current days task from firing if an email is received?
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
I think I figured it out. We'll know in 20 minutes.
I simply changed the underlined line below to TRUE. When I switched it to TRUE today's TASK was deleted and only tomorrow's TASK that it set remained in the TASK list. I'm not sure what condition wants the mail to arrived unread in order to delete the task. Hm
---------------------
Private Sub OlkInbox_ItemAdd(ByVal Item As Object)
If Item.Class = olMail Then
'Change Text within " " below this comment to the subject text you want to key on
If InStr(1, Item.Subject, "Daily 3M") Then
'Change + 24 to the number of hours you want to wait for the next message to arrive
ManageWatcherTask Now + 1
Item.UnRead = False
Item.Save
End If
End If
End Sub
I simply changed the underlined line below to TRUE. When I switched it to TRUE today's TASK was deleted and only tomorrow's TASK that it set remained in the TASK list. I'm not sure what condition wants the mail to arrived unread in order to delete the task. Hm
---------------------
Private Sub OlkInbox_ItemAdd(ByVal Item As Object)
If Item.Class = olMail Then
'Change Text within " " below this comment to the subject text you want to key on
If InStr(1, Item.Subject, "Daily 3M") Then
'Change + 24 to the number of hours you want to wait for the next message to arrive
ManageWatcherTask Now + 1
Item.UnRead = False
Item.Save
End If
End If
End Sub
ASKER
The code below has been fully tested to operate correctly. It's 100% working. It'll create a new Task every time you receive an email with the required Subject contents until you don't and it'll fire reminding you of that email.
'Macro Begins Here
Public WithEvents olkInbox As Outlook.Items
Private Sub Application_Quit()
Set olkInbox = Nothing
End Sub
Private Sub Application_Startup()
Set olkInbox = Application.GetNamespace("
End Sub
Function IsNothing(objItem As Object)
' Purpose: Tests to see if an object is not set to any value.'
' Outlook: All versions'
IsNothing = (TypeName(objItem) = "Nothing")
End Function
Private Sub OlkInbox_ItemAdd(ByVal Item As Object)
If Item.Class = olMail Then
'Change Text within " " below this comment to the subject text you want to key on
If InStr(1, Item.Subject, "Daily 3M") Then
'Change + 24 to the number of hours you want to wait for the next message to arrive
ManageWatcherTask Now + 1
'Must be set to True and not False in order to work. No idea why.
Item.UnRead = True
Item.Save
End If
End If
End Sub
Sub ManageWatcherTask(datDateD
'added this:
Dim olkTaskFolder As Outlook.Folder
'and this:
Dim olkItems As Items
Dim olkTask As Outlook.TaskItem
'used this syntax to get tasks:
Set olkTaskFolder = Session.GetDefaultFolder(o
'and items:
Set olkItems = olkTaskFolder.Items
'Change Subject below to whatever task name you want to use.
Set olkTask = olkItems.Find("[Subject] = 'Daily 3M Report'")
If Not (olkTask Is Nothing) Then
olkTask.ReminderTime = datDateDue
'added this line to change the due date as well:
olkTask.DueDate = datDateDue
olkTask.ReminderSet = True
Else
Set olkTask = Application.CreateItem(olT
With olkTask
.DueDate = datDateDue
'Make sure subject below matches the Subject above
.Subject = "Daily 3M Report"
.ReminderTime = datDateDue
.ReminderSet = True
End With
End If
olkTask.Save
Set olkTask = Nothing
'Macro ends here
End Sub
'Macro Begins Here
Public WithEvents olkInbox As Outlook.Items
Private Sub Application_Quit()
Set olkInbox = Nothing
End Sub
Private Sub Application_Startup()
Set olkInbox = Application.GetNamespace("
End Sub
Function IsNothing(objItem As Object)
' Purpose: Tests to see if an object is not set to any value.'
' Outlook: All versions'
IsNothing = (TypeName(objItem) = "Nothing")
End Function
Private Sub OlkInbox_ItemAdd(ByVal Item As Object)
If Item.Class = olMail Then
'Change Text within " " below this comment to the subject text you want to key on
If InStr(1, Item.Subject, "Daily 3M") Then
'Change + 24 to the number of hours you want to wait for the next message to arrive
ManageWatcherTask Now + 1
'Must be set to True and not False in order to work. No idea why.
Item.UnRead = True
Item.Save
End If
End If
End Sub
Sub ManageWatcherTask(datDateD
'added this:
Dim olkTaskFolder As Outlook.Folder
'and this:
Dim olkItems As Items
Dim olkTask As Outlook.TaskItem
'used this syntax to get tasks:
Set olkTaskFolder = Session.GetDefaultFolder(o
'and items:
Set olkItems = olkTaskFolder.Items
'Change Subject below to whatever task name you want to use.
Set olkTask = olkItems.Find("[Subject] = 'Daily 3M Report'")
If Not (olkTask Is Nothing) Then
olkTask.ReminderTime = datDateDue
'added this line to change the due date as well:
olkTask.DueDate = datDateDue
olkTask.ReminderSet = True
Else
Set olkTask = Application.CreateItem(olT
With olkTask
.DueDate = datDateDue
'Make sure subject below matches the Subject above
.Subject = "Daily 3M Report"
.ReminderTime = datDateDue
.ReminderSet = True
End With
End If
olkTask.Save
Set olkTask = Nothing
'Macro ends here
End Sub
Glad to have helped. The need to set the email to "unread" is a bit odd.. to be honest, I didn't even look at that piece of the code. Didn't think it would have any impact.
ASKER
Everything is working perfectly except the Old Task is firing regardless. Not sure how to keep it from firing once the new piece of mail with the criteria has arrived.