• Status: Solved
  • Priority: Low
  • Security: Public
  • Views: 48
  • Last Modified:

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?
0
Jared Davis
Asked:
Jared Davis
  • 3
  • 2
1 Solution
 
Neil FlemingIndependent consultantCommented:
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
 
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 FlemingIndependent consultantCommented:
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
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Free Tool: Port Scanner

Check which ports are open to the outside world. Helps make sure that your firewall rules are working as intended.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

  • 3
  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now