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("MAPI").GetDefaultFolder(olFolderInbox).Items
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(datDateDue As Date)
    Dim olkTaskFolder As Outlook.Items
    Dim olkTask As Outlook.TaskItem
    Set olkTaskFolder = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Items
    'Change Subject below to whatever task name you want to use.
    olkTast = olkTaskFolder.Find("[Subject] = 'Daily 3M Report'")
    If Not IsNothing(olkTask) Then
        olkTask.ReminderTime = datDateDue
        olkTask.ReminderSet = True
    Else
        Set olkTask = Application.CreateItem(olTaskItem)
        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?
Jared DavisIT SpecialistAsked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Neil FlemingConsultant and developerCommented:
I think your problem is that your code cannot find the existing task, because it is looking in the Inbox items, and not in the task list. Thus it is creating a new task each time rather than changing the old one.

Try this instead:

Sub ManageWatcherTask(datDateDue As Date)
    '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(olFolderTasks)
    '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(olTaskItem)
        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

Open in new window

0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Jared DavisIT SpecialistAuthor Commented:
It seems to still have the issue of firing the Task. So if the mail is suppose to be here at 8AM when a piece of mail with Daily 3M in the subject arrives, it successfully detects the mail and creates a new task, but still fires off the old one at 8AM regardless of the mail arriving or not.

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.
0
Jared DavisIT SpecialistAuthor Commented:
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
0
Jared DavisIT SpecialistAuthor Commented:
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("MAPI").GetDefaultFolder(olFolderInbox).Items
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(datDateDue As Date)
    '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(olFolderTasks)
    '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(olTaskItem)
        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
1
Neil FlemingConsultant and developerCommented:
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.
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Outlook

From novice to tech pro — start learning today.