Jared Davis
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").Get DefaultFol der(olFold erInbox).I tems
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(datDateD ue As Date)
Dim olkTaskFolder As Outlook.Items
olkTask As Outlook.TaskItem
olkTaskFolder = Application.GetNamespace(" MAPI").Get DefaultFol der(olFold erInbox).I tems
'Change Subject below to whatever task name you want to use.
olkTast = olkTaskFolder.Find("[Subje ct] = 'Daily 3M Alert'")
If Not IsNothing(olkTask) Then
olkTask.ReminderTime = datDateDue
olkTask.ReminderSet = True
Else
olkTask = Application.CreateItem(olT askItem)
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
'Macro Begins Here
Public WithEvents olkInbox As Outlook.Items
Private Sub Application_Quit()
olkInbox = Nothing
End Sub
Private Sub Application_Startup()
olkInbox = Application.GetNamespace("
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(datDateD
Dim olkTaskFolder As Outlook.Items
olkTask As Outlook.TaskItem
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
olkTask = Application.CreateItem(olT
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
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Okay, so changing
Private Sub Application_Startup()
olkInbox = Application.GetNamespace(" MAPI").Get DefaultFol der(olFold erInbox).I tems
End Sub
To
Private Sub Application_Startup()
Set olkInbox = Application.GetNamespace(" MAPI").Get DefaultFol der(olFold erInbox).I tems
End Sub
-------------------------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- ----------
seems to have fixed my original issue. Now I have an issue with this line of code
Sub ManageWatcherTask(datDateD ue As Date)
Dim olkTaskFolder As Outlook.Items
olkTask As Outlook.TaskItem
olkTaskFolder = Application.GetNamespace(" MAPI").Get DefaultFol der(olFold erInbox).I tems
Throwing this error: Compile Error Statement Invalid Outside of Type Block. Underlined above
Private Sub Application_Startup()
olkInbox = Application.GetNamespace("
End Sub
To
Private Sub Application_Startup()
Set olkInbox = Application.GetNamespace("
End Sub
--------------------------
seems to have fixed my original issue. Now I have an issue with this line of code
Sub ManageWatcherTask(datDateD
Dim olkTaskFolder As Outlook.Items
olkTask As Outlook.TaskItem
olkTaskFolder = Application.GetNamespace("
Throwing this error: Compile Error Statement Invalid Outside of Type Block. Underlined above
ASKER
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.
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.
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
»bp
ASKER
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.
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
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
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").Get DefaultFol der(olFold erInbox).I tems
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(datDateD ue As Date)
Dim olkTaskFolder As Outlook.Items
Dim olkTask As Outlook.TaskItem
Set olkTaskFolder = Application.GetNamespace(" MAPI").Get DefaultFol der(olFold erInbox).I tems
'Change Subject below to whatever task name you want to use.
olkTast = olkTaskFolder.Find("[Subje ct] = 'Daily 3M Report'")
If Not IsNothing(olkTask) Then
olkTask.ReminderTime = datDateDue
olkTask.ReminderSet = True
Else
olkTask = Application.CreateItem(olT askItem)
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
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("
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(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
olkTask = Application.CreateItem(olT
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
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
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.
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.
ASKER
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").Get DefaultFol der(olFold erInbox).I tems
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 ue As Date)
Dim olkTaskFolder As Outlook.Items
Dim olkTask As Outlook.TaskItem
Set olkTaskFolder = Application.GetNamespace(" MAPI").Get DefaultFol der(olFold erInbox).I tems
'Change Subject below to whatever task name you want to use.
olkTast = olkTaskFolder.Find("[Subje ct] = 'Daily 3M Report'")
If Not IsNothing(olkTask) Then
olkTask.ReminderTime = datDateDue
olkTask.ReminderSet = True
Else
Set olkTask = Application.CreateItem(olT askItem)
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
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("
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
ASKER
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").Get DefaultFol der(olFold erInbox).I tems
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 ue As Date)
Dim olkTaskFolder As Outlook.Items
Dim olkTask As Outlook.TaskItem
Set olkTaskFolder = Application.GetNamespace(" MAPI").Get DefaultFol der(olFold erInbox).I tems
'Change Subject below to whatever task name you want to use.
olkTast = olkTaskFolder.Find("[Subje ct] = 'Daily 3M Report'")
If Not IsNothing(olkTask) Then
olkTask.ReminderTime = datDateDue
olkTask.ReminderSet = True
Else
Set olkTask = Application.CreateItem(olT askItem)
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
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("
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
Great, glad I was able to help you.
»bp
»bp
ASKER