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.
Related
I have a client that would like any email deleted from within certain folders in Outlook to go into a sub-folder of her Deleted Items automatically. There are 3 different folders she would like this to happen for, all are sub-folders of her Inbox.
I am mildly VBA savvy, meaning I can usually hack something together from similar code to make it fit what I am trying to accomplish, but I have not been able to find anything close enough to what she is asking for that I could modify to fit this need.
Any tips would be appreciated.
Edit:
Adding the code I used in case someone else could benefit from it:
Dim WithEvents olFolder1 As Outlook.Folder
Dim WithEvents olFolder2 As Outlook.Folder
Dim WithEvents olFolder3 As Outlook.Folder
Dim olDelFolder As Outlook.Folder
Dim olDestFolder As Outlook.Folder
Private Sub Application_Startup()
Set olFolder1 = Application.Session.GetDefaultFolder(olFolderInbox)
Set olFolder1 = olFolder1.Folders("Subfolder of Inbox Name")
Set olFolder1 = olFolder1.Folders("Subfolder of Subfolder Name")
Set olFolder2 = Application.Session.GetDefaultFolder(olFolderInbox)
Set olFolder2 = olFolder2.Folders("Subfolder of Inbox Name")
Set olFolder2 = olFolder2.Folders("Subfolder of Subfolder Name")
Set olFolder3 = Application.Session.GetDefaultFolder(olFolderInbox)
Set olFolder3 = olFolder3.Folders("Subfolder of Inbox Name")
Set olFolder3 = olFolder3.Folders("Subfolder of Subfolder Name")
Set olDelFolder = Application.Session.GetDefaultFolder(olFolderDeletedItems)
Set olDestFolder = olDelFolder.Folders("Subfolder of Deleted Items Name")
End Sub
Private Sub olFolder1_BeforeItemMove(ByVal Item As Object, ByVal MoveTo As MAPIFolder, Cancel As Boolean)
If MoveTo = olDelFolder Then
Cancel = True
Item.Move olDestFolder
Else
Cancel = False
End If
End Sub
Private Sub olFolder2_BeforeItemMove(ByVal Item As Object, ByVal MoveTo As MAPIFolder, Cancel As Boolean)
If MoveTo = olDelFolder Then
Cancel = True
Item.Move olDestFolder
Else
Cancel = False
End If
End Sub
Private Sub olFolder3_BeforeItemMove(ByVal Item As Object, ByVal MoveTo As MAPIFolder, Cancel As Boolean)
If MoveTo = olDelFolder Then
Cancel = True
Item.Move olDestFolder
Else
Cancel = False
End If
End Sub
Note:
If a message is manually moved to the Deleted Items folder instead of being deleted in a traditional way, a copy of the message ends up in both the Deleted Items and the specified Sub-folder. Not sure why that is, but the end user won't be manually moving messages like that so it wasn't something I needed to fix.
Use the Folder.BeforeItemMove event which is fired when an item is about to be moved or deleted from a folder, either as a result of user action or through program code. The second parameter represents the folder to which the item is being moved. So, you can check whether it is Deleted Folder or not. If so, you may cancel the default action by setting the third parameter to true. Set the Cancel parameter to `true to cancel the move or delete action. Then you may programmatically move the item to the required destination instead.
I'd rather use Items.ItemAdd event on the Deleted Items folder. Unlike the Folder.BeforeItemMove event (which is UI specific and does not fire in all cases), Items.ItemAdd event is much more reliable.
I would like to move emails to a sub-folder of my inbox when I assign it a category
I found the following code from Extended Office but it does not work.
It is supposed to move mail to a subfolder with the same name as the category and create a folder if it does not exist.
I have enabled macros in Outlook's security settings and inserted some message box alerts to confirm that does in fact run.
The code is in ThisOutlookSession
Private WithEvents xInboxFld As Outlook.Folder
Private WithEvents xInboxItems As Outlook.Items
Private Sub Application_Startup()
MsgBox "Macros are working"
Set xInboxFld = Outlook.Application.Session.GetDefaultFolder(olFolderInbox)
Set xInboxItems = xInboxFld.Items
End Sub
Private Sub xInboxItems_ItemChange(ByVal Item As Object)
MsgBox "Item Changed"
Dim xMailItem As Outlook.MailItem
Dim xFlds As Outlook.Folders
Dim xFld As Outlook.Folder
Dim xTargetFld As Outlook.Folder
Dim xFlag As Boolean
On Error Resume Next
If Item.Class = olMail Then
Set xMailItem = Item
xFlag = False
If xMailItem.Categories <> "" Then
Set xFlds = Application.Session.GetDefaultFolder(olFolderInbox).Folders
If xFlds.Count <> 0 Then
For Each xFld In xFlds
If xFld.Name = xMailItem.Categories Then
xFlag = True
End If
Next
End If
If xFlag = False Then
Application.Session.GetDefaultFolder(olFolderInbox).Folders.Add xMailItem.Categories, olFolderInbox
End If
Set xTargetFld = Application.Session.GetDefaultFolder(olFolderInbox).Folders(xMailItem.Categories)
xMailItem.Move xTargetFld
End If
End If
End Sub
I don't know exactly why but this suddenly started working today, I had restarted Outlook several times before but after I needed to force close Outlook this morning it started working.
(I'm not even sure if it started working immediately because of the restart or if it was a short time afterwards triggered by something else)
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
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 :)
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