Link to home
Start Free TrialLog in
Avatar of Jared Davis
Jared DavisFlag for United States of America

asked on

Outlook VBA Macro

Hey guys, I took some code from someone on these forums and altered it some in Visual Studio to work with Outlook 2016. Except I am having an issue with a line I cannot figure out.  It's just suppose to alert the user that they did not receive an email and if they did receive the daily email the task resets itself to go off in the eventuality an email is not received on time. I underlined the line that the debugger is catching and saying olkInbox = Nothing

'Macro Begins Here
Public WithEvents olkInbox As Outlook.Items

Private Sub Application_Quit()
    olkInbox = Nothing
End Sub

Private Sub Application_Startup()
    olkInbox = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Items
End Sub

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 + 24)
            Item.UnRead = False
            Item.Save
        End If
    End If
End Sub

Sub ManageWatcherTask(datDateDue As Date)
    Dim olkTaskFolder As Outlook.Items
    olkTask As Outlook.TaskItem
    olkTaskFolder = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Items
    'Change Subject below to whatever task name you want to use.
    olkTast = olkTaskFolder.Find("[Subject] = 'Daily 3M Alert'")
    If Not IsNothing(olkTask) Then
        olkTask.ReminderTime = datDateDue
        olkTask.ReminderSet = True
    Else
        olkTask = Application.CreateItem(olTaskItem)
        With olkTast
            .DueDate = datDateDue
            'Make sure subject below matches the Subject above
            .Subject = "Daily 3M Alert"
            .ReminderTime = datDateDue
            .ReminderSet = True
        End With
    End If
    olkTask.Save
    olkTask = Nothing
    'Macro ends here

End Sub
ASKER CERTIFIED SOLUTION
Avatar of Bill Prew
Bill Prew

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of Jared Davis

ASKER

Oh, okay. I thought they did away with the Set / Let stuff. I don't have much experience in VBA at all. So you think I should put the Sets back?
Okay, so changing

Private Sub Application_Startup()
    olkInbox = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Items
End Sub

To

Private Sub Application_Startup()
    Set olkInbox = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Items
End Sub
--------------------------------------------------------------------------------------------------------------------
seems to have fixed my original issue. Now I have an issue with this line of code

Sub ManageWatcherTask(datDateDue As Date)
    Dim olkTaskFolder As Outlook.Items
   olkTask As Outlook.TaskItem
    olkTaskFolder = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Items

Throwing this error: Compile Error Statement Invalid Outside of Type Block. Underlined above
I know in Visual Studio

olkTask As Outlook.TaskItem

is throwing a red squiggly line under AS and it says Expression Expected but it's also yelling at me not to use Let and Set, but it fixed some issues I was having in Outlook already by putting them back. However, I have changed nothing for the line above.
Avatar of Bill Prew
Bill Prew

Just to be clear, you are trying to create a VBS script that will run stand alone, not a Visual Studio type project, etc?


»bp
Yessir, I am just trying to get the Script to run with Outlook from the Developer Macro panel. I was just editing it in Visual Studio even though Outlook has its own Editor.

Here's the original post from Exchange.

https://www.experts-exchange.com/questions/21667246/Create-An-Outlook-Alert-Non-Received-E-Mails.html

But it was several years ago.
SOLUTION
Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Okay, that fixed that issue. Now it seems to be another issue. What in the world. At least it's getting lower and lower and not further up in the code. Would you mind taking a look one more time?

Compile Error Sub or Function Not Defined - on the line below. I'll list the total code again so you dont have to scroll up if you can find it in your heart to take another look. I underlined it in the main code below as well.
If Not IsNothing(olkTask) Then

-----------------------------------------------------------

'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

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 + 24)
            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
        olkTask = Application.CreateItem(olTaskItem)
        With olkTast
            .DueDate = datDateDue
            'Make sure subject below matches the Subject above
            .Subject = "Daily 3M Report"
            .ReminderTime = datDateDue
            .ReminderSet = True
        End With
    End If
    olkTask.Save
    olkTask = Nothing
    'Macro ends here

End Sub
SOLUTION
Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Okay, so it's close to being done. It's now detecting when I receive the email with the keywords Daily 3M in the subject title, however, when it fires. It gives me an error and marks this line. When I hover over the datDueDate in the image, you'll see it, the date is wrong.

It says RunTime Error Object Required

-------

If I change the line ManageWatcherTask Now + 1 it corrects the date to be 24 hours from when the message was received. Which is great, but the error still remains saying Object Required.

So it seems to obviously be triggering a reset date in code, but it's not applying it to the Task for some reason.

User generated image
OMG! I finally got it to work. THANK YOU SO MUCH BILL PREW!!!

He misspelled a TASK as TAST in there and he forgot to put a SET. YAY!!

Here's the full working code for the Outlook Macro to alert you if you do not receive your daily emails by a certain time.

Works with Outlook Exchange 2016
------------------------------------------------------------------------------------------------

'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
Here's the full working Code.

This Macro will work in Outlook 2016. This will trigger a Task to remind you if you do NOT receive a daily email you expect by a certain time.

'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
Great, glad I was able to help you.


»bp