Automatically Mark email in Deleted Items as Read Outlook 2016 VBA - vba

I had a little macro set up with Outlook on another machine but now that I've switched computers I can't get it to work. When I try to run the last Private Sub, it doesn't recognize the name and pulls up the Macro selection box with no options listed.
I dislike having to manually mark emails in the Deleted Items folder as read, especially considering they had the amazing foresight to mark discarded drafts as unread.
Here's the code that used to work:
Dim WithEvents g_OlkFolder As Outlook.Items
Private Sub Application_Quit()
Set g_OlkFolder = Nothing
End Sub
Private Sub Application_Startup()
Set g_OlkFolder = Session.GetDefaultFolder(olFolderDeletedItems).Items
End Sub
Private Sub g_OlkFolder_ItemAdd(ByVal Item As Object)
Item.UnRead = False
Item.Save
End Sub

Here are a few things to try and check:
Put the cursor in the Application_Startup method and press F5. Then go back and try again. If this helps, the initialization has not run, and the g_OlkFolder variable is not set.
Put a breakpoint on the Item.UnRead = False line. If it doesn't stop there, your method isn't running.
Have you put your code in the ThisOutLookSession module?

Try using Application.Session property, or use GetNamespace method which I prefer
Example
Private WithEvents Items As Outlook.Items
Private Sub Application_Startup()
Dim olNs As Outlook.NameSpace
Dim DeletedFolder As Outlook.MAPIFolder
Set olNs = Application.GetNamespace("MAPI")
Set DeletedFolder = olNs.GetDefaultFolder(olFolderDeletedItems)
Set Items = DeletedFolder.Items
End Sub
Private Sub Items_ItemAdd(ByVal Item As Object)
If TypeOf Item Is Outlook.MailItem Then
' do something with Item
End If
End Sub

Or define olFolderDeletedItems or replace it with 3.
See this link for details.

Upon completely throwing away my code and starting from scratch I figured out a much simpler solution than what I was trying. Thanks for all the help anyways guys!
Sub MDAU()
Dim DI As Outlook.Items
Dim MSG As Object
Set DI = Session.GetDefaultFolder(olFolderDeletedItems).Items
Set MSG = Application.CreateItem(olMailItem)
For Each MSG In DI
MSG.UnRead = False
Next
End Sub

Related

Rerun Outlook VBA script 'Application_Startup' regularly

I have (using information from SO) implemented a VBA macro that runs to process new emails after the 'run a script' options was removed from the Outlook rules. I do this as follows:
Private WithEvents Items As Outlook.Items
Public Sub Application_Startup()
' Add an inbox event listener
Dim olApp As Outlook.Application
Dim objNS As Outlook.NameSpace
Set olApp = Outlook.Application
Set objNS = olApp.GetNamespace("MAPI")
' default local Inbox
Set Items = objNS.GetDefaultFolder(olFolderInbox).Items
MsgBox "Startup macro run"
End Sub
Private Sub Items_ItemAdd(ByVal item As Object)
'Do something on new email arrival
.
.
.
End Sub
However the inbox listener appears to frequently stop working and I either have to restart Outlook or re-run the 'Startup' macro manually to kick it back into life - this appears to be a common problem with no solution.
Question - I'm not a VBA expert and I was wondering if I can I simply re-run the 'Application_Startup' macro to restart the listener at the end of the 'Items_ItemAdd(ByVal item As Object)' macro?
If you need to reset the ItemAdd event handler, I don't think using ItemAdd to do that makes any sense.
You can either use a timer (which does not exist in VBA) or you can use some other event that fires more or less frequently, such as the Explorer.SelectionChange event (Explorer can be retrieved from Application.ActiveExplorer).
You could add a new macro that does the actions originally present in the Application_Startup event. Then you could later refer to that sub at the end of your Items_ItemAdd macro.
Private WithEvents Items As Outlook.Items
Public Sub Application_Startup()
Call startupevents
End Sub
Sub startupevents()
' Add an inbox event listener
Dim olApp As Outlook.Application
Dim objNS As Outlook.NameSpace
Set olApp = Outlook.Application
Set objNS = olApp.GetNamespace("MAPI")
' default local Inbox
Set Items = objNS.GetDefaultFolder(olFolderInbox).Items
MsgBox "Startup macro run"
End Sub
Private Sub Items_ItemAdd(ByVal item As Object)
'Do something on new email arrival
'
'
'
Call startupevents
End Sub
Simpler code may have an impact.
Private WithEvents Items As Outlook.Items
Public Sub Application_Startup()
' Add an inbox event listener
Dim objNS As Outlook.NameSpace
' The code is in Outlook, not being called, for example, from Excel.
Set objNS = Session.GetNamespace("MAPI")
' default local Inbox
Set Items = objNS.GetDefaultFolder(olFolderInbox).Items
MsgBox "Startup macro run"
End Sub
If the above has no impact then this may rerun Application_Startup frequently enough.
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Application_Startup
End Sub

How to implement ItemChange for many Outlook subfolders?

In a VBA module in Outlook I have currently code like this:
Private WithEvents AAInboxItems As Outlook.Items
Private WithEvents AASentItems As Outlook.Items
Private WithEvents AADoneItems As Outlook.Items
Private Sub AAInboxItems_ItemChange(ByVal Item As Object)
'Do Something
End Sub
Private Sub AASentItems_ItemChange(ByVal Item As Object)
'Do Something
End Sub
Private Sub AADoneItems_ItemChange(ByVal Item As Object)
'Do Something
End Sub
Above is not the complete code, just to show the principle. This works fine for a couple of folders for which I implemented this.
I would like to have such events for all subfolders of the Inbox. And this should work dynamically. If the user creates a new sub-folder then I don't want to change the code. I want to have an event which fires when an item is changed in any Outlook Inbox subfolder.
Is that possible? How?
Edit: With Dmitry Streblechenko's answer I tried the following but it does not do what I want it to do - maybe I implemented it incorrectly.
The events fire but only for the last assigned folder and not all folders.
This is what I expected but maybe I made something wrong or didn't understand the answer correct. I put this information in the question because it won't fit in a comment to Dmitry's answer.
The following are the most important parts of the code. I leave lots of details out to make it shorter. Basically it works, but only for one folder.
Option Explicit
Global gbl_FolderItems(3) As Outlook.Items
Private WithEvents FolderItems As Outlook.Items
Private Sub Application_Startup()
For intI = 1 To 3
'This works only with the last folder
'Set gbl_FolderItems(intI) = objGetFolderItems("Folder" & intI)
'Set FolderItems = gbl_FolderItems(intI)
'This works only with the last folder
Set FolderItems = objGetFolderItems("Folder" & intI)
Set gbl_FolderItems(intI) = FolderItems
Next
End Sub
Private Function objGetFolderItems(strFolderShortName As String) As Outlook.Items
Dim olApp As Outlook.Application
Set olApp = Outlook.Application
Dim objNS As Outlook.NameSpace
Set objNS = olApp.GetNamespace("MAPI")
Dim obj As Outlook.Items
Select Case strFolderShortName
Case "Folder1"
Set obj = objNS.Folders("MyAccount").Folders("Inbox").Folders("Folder1").Items
Case "Folder2"
Set obj = objNS.Folders("MyAccount").Folders("Inbox").Folders("Folder2").Items
Case "Folder3"
Set obj = objNS.Folders("MyAccount").Folders("Inbox").Folders("Folder1").Folders("Folder3").Items
End Select
Set objGetFolderItems = obj
End Function
Private Sub FolderItems_ItemChange(ByVal Item As Object)
Debug.Print "FolderItems_ItemChange(" & Item.Subject & ")"
End Sub
Private Sub FolderItems_ItemAdd(ByVal Item As Object)
Debug.Print "FolderItems_ItemAdd(" & Item.Subject & ")"
End Sub
You may consider creating a COM add-in instead. In that case you will be able to subscribe to folder events dynamically. See Walkthrough: Creating Your First VSTO Add-In for Outlook for more information.
Also you may consider using a low-level API - Extended MAPI. See MAPI Notification Events for more information. Or just use any third-party wrappers around that API such as Redemption.
Declare a single WithEvents Items variable, loop through the folders that you want to track, assign the Items variable, and store it in a global array. Even though the variable will be overwritten on each iteration, all of the folders will be monitored because all the different Items objects are still alive and raising events since they are referenced by the array.
There is a solution, it's pure VBA, however it's not so straightforward:
create a HandlerClass with singular event NewItem and one public method to raise it from outside of the class:
Public Event NewItem(ByVal Item As Object)
Public Sub raise(ByVal Item As Object)
RaiseEvent NewItem(Item)
End Sub
create a FolderWatcherClass holding singular folder and handling its Items' ItemAdd event:
Private folder As Outlook.MAPIFolder
Private WithEvents fItems As Outlook.Items
Private handler As CLAhandler
Public Sub init(f As Outlook.MAPIFolder, h As CLAhandler)
Set folder = f
Set fItems = f.Items
Set handler = h
End Sub
Private Sub fItems_ItemAdd(ByVal Item As Object)
Call handler.raise(Item)
End Sub
You have the two classes defined now, so declare the handler and array of watchers in the module:
Private WithEvents commonEventHandler As HandlerClass
Private folderWatchers() As FolderWatcherClass
then initialize them
Private Sub Application_Startup()
' create new WithEvents handler object, common to all folderWatchers
Set commonEventHandler = New HandlerClass
' hook folder handlers
' start with the Inbox, then traverse recursively all the subfolders
Call ProcessFolder(Outlook.Application.Session.GetDefaultFolder(olFolderInbox))
End Sub
Private Sub ProcessFolder(ByVal thisFolder As Outlook.MAPIFolder)
Dim subFolder As Outlook.MAPIFolder
Dim u As Long
' tricky check if the folderWatchers array has been initialized - assuming its UBound 'sbeen not initialized to -1 :)
u = -1
On Error Resume Next
u = UBound(folderWatchers)
On Error GoTo 0
' redim the array
If u = -1 Then
' the first folder, presumably the Inbox itself
ReDim folderWatchers(1 To 1)
Else
' all the subsequent subfolders
ReDim Preserve folderWatchers(1 To UBound(folderList) + 1)
End If
' store a new instance of folder watcher in the array
Set folderWatchers(UBound(folderWatchers)) = New FolderWatcherClass
' initialize it (WithEvents in the FolderWatcherClass!) with the thisFolder and the common event handler
Call folderWatchers(UBound(folderWatchers)).init(thisFolder, commonEventHandler) ' pass THE SAME common event handler to each of the watchers!
' process the subfolders in the current folder recursively
If (thisFolder.Folders.Count > 0) Then
For Each subFolder In thisFolder.Folders
If subFolder.DefaultItemType = olMailItem Then Call ProcessFolder(subFolder) ' process only the folders containing mail items
Next
End If
' you can refine the criteria above to watch only specified folders if needed
End Sub
Now it's the only one thing left to make it work, we have to handle the common event:
Private Sub commonEventHandler_NewItem(ByVal Item As Object)
' do whatever you like here
End Sub
Summarizing:
The HandlerClass provides singular event handler for all the folders
The FolderWatcherClass array holds each of the folders redirecting their ItemAdd events to the common HandlerClass object
Disclaimer: I renamed variables, methods and objects used in my original code to make them more understandable - I hope I've done it consequently and the code is consistent :)

How to trigger ItemChange when a Task is updated?

I took this code from the internet to automatically send the tasks that are completed to a specific folder ("Completed Tasks"). It didn't work, I would click to complete the task and it wouldn't get moved.
I put msgboxes to pop up at three parts of the code to see where the problem is. The initialization box pops up, but the box corresponding to the ItemChange doesn't, and the other one doesn't as well. My impression is that the ItemChange isn't being called.
Public WithEvents olItems As Outlook.Items
Public Sub Application_Startup()
Set olItems = Session.GetDefaultFolder(olFolderTasks).Items
MsgBox ("initialized")
End Sub
Public Sub olItems_ItemChange(ByVal Item As Object)
Dim CompTaskf As Folder
MsgBox ("detected change")
If Item.Complete = True And Item.IsRecurring = False Then
MsgBox ("condition met")
Set CompTaskf = Session.GetDefaultFolder(olFolderTasks).Folders("Completed Tasks")
Item.Move CompTaskf
End If
End Sub
I tried:
Changing the folder permissions and starting Outlook in administrator mode.
Pointing it to a single folder with a few tasks.
Setting CompTaskf as a global variable.
Edit: corrected myolItems to olItems, now it works but only if I point to a single folder with few tasks:
Set myolItems = Session.GetDefaultFolder(olFolderTasks).Folders("Inbox").Items
It doesn't work without the .Folders(Inbox")
I thought .Items wasn't returning the items when attached right after the default folder.
I found a way to point olItems to the current folder by defining it as so every time I switch folders.
Public WithEvents olItems As Outlook.Items
Public WithEvents daFolder As Outlook.Explorer
Public Sub Application_Startup()
Set daFolder = Application.ActiveExplorer
'MsgBox ("initialized")
End Sub
'Sets daFolder as the active explorer window on startup,
' apparently necessary because i can't put
' Application.ActiveExplorer_FolderSwitch() as the sub
Public Sub daFolder_FolderSwitch()
Set olItems = Application.ActiveExplorer.CurrentFolder.Items
End Sub
'Every time i switch between folders, set olItems as the items of the current folder
Public Sub olItems_ItemChange(ByVal Item As Object)
Dim CompTaskf As Folder
'MsgBox ("detected change")
If TypeName(Item) = "TaskItem" And Item.Complete = True And Item.IsRecurring = False Then 'This verification that it's a task item is necessary, otherwise the code may crash
'MsgBox ("condition met")
Set CompTaskf = Session.GetDefaultFolder(olFolderTasks).Folders("Completed Tasks") 'Set folder i want to move tasks to
Item.Move CompTaskf 'Move task to the folder
End If
End Sub
The olItems variabel is never initialized. You are initializing the undeclared myolItems variable.

How can I trigger an event when multiple items added at once to Outlook Folder?

I use event handlers in VBA and Outlook frequently. One of them is one which marks any item which is deleted to be marked as read.
Private Sub deletedItems_ItemAdd(ByVal Item As Object)
Application_Startup
On Error Resume Next
Item.UnRead = False
End Sub
Declared via:
Private WithEvents deletedItems As Outlook.Items
and initialized in Application_Startup as:
Dim olNameSpace As Outlook.NameSpace
Set olNameSpace = olApp.GetNamespace("MAPI")
Set deletedItems = olNameSpace.GetDefaultFolder(olFolderDeletedItems).Items
Unfortunately, this does not affect all the items if I delete multiple items at once.
Is there a way I can do something to hijack this process somehow? I looked into using the _beforeDelete event but you have to set the item correctly each time, which if I could do this problem wouldn't exist anyways.
Apparently I wasn't clear - the use case I have is when I delete messages via the delete key from my inbox, drafts, whatever.
You don't have to.
I was curious about your question so I opened up Outlook and wrote this code in ThisOutlookSession:
Private WithEvents items As Outlook.items
Public Sub SetItems()
Set items = Application.GetNamespace("MAPI") _
.GetDefaultFolder(olFolderDeletedItems) _
.items
End Sub
Private Sub items_ItemAdd(ByVal Item As Object)
Dim mail As MailItem
On Error Resume Next
Set mail = Item
Err.Clear
On Error GoTo 0
If Not mail Is Nothing Then
MsgBox mail.Subject
mail.UnRead = False
End If
End Sub
Then I ran SetItems from the immediate pane, went to my inbox and deleted a SMS message - as expected mail was Nothing. Then I deleted a single email, and got the message with the mail's subject.
When I selected two emails and hit Delete, the event was fired once for each selected email, so I saw two message boxes - it just works! :)
The Outlook API doesn't seem to offer an event which would handle all deletions at once.
i have (almost) exactly the same code and it works also for multiple items - only after sleep-mode Outlook seems to forget how to handle deleted items...
Option Explicit
Public WithEvents itDeleted As items
Private Sub Application_Startup()
Set itDeleted = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderDeletedItems).items
End Sub
Private Sub itDeleted_ItemAdd(ByVal Item As Object)
'MsgBox "deleted-sub fired" 'this only for test-purposes
If TypeOf Item Is MailItem Then
Item.UnRead = False
End If
End Sub
I think the difference in the definition of "deletedItems" is the problem; that you are not checking the mailitem-property is also not optimal.
Hope this helps,
Max

While itemadd event works in my outlook it doesn't work in friends pc

I have code which works in my system but not in my friend's PC. Both use the same Outlook version.
Here is the snippet.
Private WithEvents olInboxItems As Items
Private Sub start_Click()
Dim objNS As nameSpace
Set objNS = Application.Session
' instantiate objects declared WithEvents
Call accessInbox(inbox) // my own function
Set olInboxItems = inbox.Items
'Set objNS = Nothing
Me.Hide
End Sub
Private Sub olInboxItems_ItemAdd(ByVal Item As Object)
On Error Resume Next
MsgBox "a Message recieved"
'Call download(Item)
Call multiSubjectDownload(Item) //my own function
End Sub
What may be the problem?
Are there settings that differ which prevent the code detecting new mail in inbox?
i found the error i was n't referring to inbox. so event was not firing because my item event was on inbox :)