Outlook "Snooze" Email Until Time In Same Day - vba

I am currently using a view filter to "snooze" email -- which means the email is hidden from view when a followup flag is placed on it until the flag is set for followup on "today." This is the basic view filter setup in the advanced tab of view filter in Outlook:
I often have email I want to hide until it is actionable later in the day. Ideally, I would be able to use a nice UI (eg Gmail) such as this one:
I have attempted to leverage the view-hide method to manage this by categorizing emails, running a rule to hide the email when categorized, then removing the categorization at a particular time, but I couldn't find a nice way to 1-run a rule on categorization that already exists (1- is outline in the comments), and 2-run a rule on the whole folder at a particular time (2-is now outlined below).
The other approach I tried was to move emails to a particular folder (ie, snooze until 2 PM, snooze until 4 pm, etc) and then have them move back to inbox at a particular time via a rule or a script. Unfortunately, the rule would run but only on incoming emails -- it didn't automatically process the emails that were already in the folder. I attempted adapting a few scripts, but I was unsuccessful enough that I won't include them here.
Suggestions on a better approach or fleshing out the approaches I tried?
UPDATE
The only thing I need to finish this project is VBA code that runs on a schedule, and possibly syntax to run a rule correctly. eg, if the rule is Snoozetill3, then how does one run Snoozetill3.execute() correctly (that doesn't work)?
This code, per this SO post, will move all the Files from folder TODO to folder Test:
Sub MoveItems()
Dim myNameSpace As Outlook.NameSpace
Dim myInbox As Outlook.Folder
Dim myDestFolder As Outlook.Folder
Dim myItems As Outlook.Items
Dim myItem As Object
Set myNameSpace = Application.GetNamespace("MAPI")
Set myInbox = myNameSpace.GetDefaultFolder(olFolderInbox)
Set myItems = myInbox.Items
Set myDestFolder = myInbox.Folders("test")
Set myItems = myInbox.Folders("TODO").Items
'Debug.Print myItems.Count
For i = myItems.Count To 1 Step -1 'Iterates from the end backwards
myItems.Item(i).Move myDestFolder
Next
End Sub

Related

Looping through specific subfolders in outlook containing a specific string

I want to look for specific items inside specific subfolders in Outlook (macro VBA) that can be in first or second level subfolder, however I cannot make it to work. I have found other questions that loop through all the items in all folders, but not that go through all items in specific subfolders.
fldrname = "Clearing"
Set objNS = GetNamespace("MAPI")
Set ClearingFolders = Outlook.Folders("Clearing", objNS.Folders)
For Each ClearingFolders In objParentFolderCollection
For Each folder In ClearingFolders
If InStr(1, fldrname, folder.Name, vbTextCompare) > 0 Then
{findEmail}
End If
Next folder`
Thanks for your help!
The code below demonstrates how to access every mail item within every folder, and sub-folder to any depth, within a parent folder. It does this by outputting an indented list of items and sub-folders to the Immediate Window. The format of the output is:
ParentFolderName
Date Subject (of mail item within ParentFolder
Date Subject (of mail item within ParentFolder
Date Subject (of mail item within ParentFolder
ChildFolder1Name
Date Subject (of mail item within ChildFolder1Name
Date Subject (of mail item within ChildFolder1Name
GrandchildFolder1Name
Date Subject (of mail item within GrandchildFolder1Name
Date Subject (of mail item within GrandchildFolder1Name
ChildFolder2Name
Date Subject (of mail item within ChildFolder2Name
Date Subject (of mail item within ChildFolder2Name
GrandchildFolder2Name
Date Subject (of mail item within GrandchildFolder2Name
Date Subject (of mail item within GrandchildFolder2Name
GreatgrandchildFolder1Name
Date Subject (of mail item within GreatgrandchildFolder1Name
Date Subject (of mail item within GreatgrandchildFolder1Name
ChildFolder3Name
: : : : :
There are statements within your code I do not understand so I have ignored your code and created my own.
Consider first:
Set Fldr = Session.Folders("StoreName").Folders("TopLevelFolderName")
Your equivalent of this statement is:
Set objNS = GetNamespace("MAPI")
Set Fldr = objNS.Folders("StoreName").Folders("TopLevelFolderName")
With VBA there is often more than one way of achieving the same effect. I prefer Session to objNS. My code so my favourites. Change to your favourite if you wish.
A store is a file on disc that Outlook uses to hold mail items, tasks, appointment items and so on. I assume “Clearing” is the name of a folder and not the name of a store. Your folder pane will look something like this:
StoreName1
Clearing1
Deleted Items
Inbox
Sent Items
StoreName2
Inbox
Clearing2
Sent
Trash
You can have as many stores as you wish. There will be one per email address and perhaps one for archives. When I change computers, I add my old stores to my new Outlook installation, so I have access to all my old emails.
It seems there is always an “Inbox”. Other standard folders change their names from version to version so you might have “Deleted Items” or “Trash” or something else. You can add your own folders wherever you like.
If your “Clearing” is a store, you will need:
Set Fldr = Session.Folders("Clearing")
If your “Clearing” is at the same level as “Inbox” like my “Clearing1”, you will need:
Set Fldr = Session.Folders("StoreName1").Folders("Clearing1")
If your “Clearing” is under “Inbox” like my “Clearing2”, you will need:
Set Fldr = Session.Folders("StoreName2").Folders("Inbox").Folders("Clearing2")
Change my statement to match your system.
Notice that I write:
Dim Fldr As Outlook.Folder
but
Dim ItemCrnt As MailItem
This code runs under Outlook so I do not need to specific Outlook. I could have written Outlook.MailItem but it would not add value because VBA only has one data type named MailItem. However, Outlook as two data types Folder; one for disc folders and one for Outlook folders. Outlook VBA will assume you mean Outlook.Folder when you write Folder but I once got myself into a muddle when I did not specify which Folder I meant. Now, I am always careful to write Outlook.Folder or Scripting.Folder so I will not forget when it is important.
The sub ProcessChild is recursive. There are excellent explanations of recursion on the web so I will not attempt my own explanation now. However, if you are confused, I will add an explanation of my routine.
Now consider:
For InxI = 1 To FldrPrnt.Items.Count
: : :
For InxF = 1 To FldrPrnt.Folders.Count
You have used For Each. I sometimes use For Each but I find For Index more convenient most of the time.
FldrPrnt is the folder whose mail items and sub-folders I wish to access. FldrPrnt.Items gives me access to the items and FldrPrnt.Folders gives me access to the sub-folders.
When I write For InxI = 1 To FldrPrnt.Items.Count, I access the items oldest first. If I had written For InxI = FldrPrnt.Items.Count to 1 Step -1, I would have accessed the items newest first. “Oldest” and “Newest” here does not refer to the date of the item. It refers to the order in which items were added to FldrPrnt.Items. Normally mail items are added in date order so these two orders are the same. However, if you accidentally delete an old mail item then move it back from folder “Deleted Items”, it will become the newest item in the folder.
Often you can write either For InxI = 1 To FldrPrnt.Items.Count or For InxI = FldrPrnt.Items.Count to 1 Step -1. However, if your processing involves moving items to another folder, you must use FldrPrnt.Items.Count to 1 Step -1. With For Index, you are identifying items by their position within FldrPrnt.Items. If you move item 20 to another folder, item 21 becomes item 20, item 22 becomes item 21 and so on. For the next repeat of the loop, you will check the new item 21 not the old item 21. We sometimes get questions where someone is only checking half their items. This is the reason.
Notice If TypeName(FldrPrnt.Items(InxI)) = "MailItem" Then. Not every item is a MailItem. It is essential to check an item’s type before processing it since different items have different properties.
I hope the above, is enough for you to understand my code but ask question is necessary. All my code does is display the received time and subject of each mail item. You will have to replace my Debug.Print statement with whatever code you need to achieve your objectives.
Option Explicit
Sub Main()
Dim Fldr As Outlook.Folder
Set Fldr = Session.Folders("StoreName").Folders("TopLevelFolderName")
Call ProcessChild(Fldr, 0)
End Sub
Sub ProcessChild(ByRef FldrPrnt As Outlook.Folder, ByVal Indent As Long)
Dim InxF As Long
Dim InxI As Long
Dim ItemCrnt As MailItem
Debug.Print Space(Indent * 2) & FldrPrnt.Name
For InxI = 1 To FldrPrnt.Items.Count
If TypeName(FldrPrnt.Items(InxI)) = "MailItem" Then
Set ItemCrnt = FldrPrnt.Items(InxI)
With ItemCrnt
Debug.Print Space(Indent * 2 + 2) & .ReceivedTime & " " & .Subject
End With
End If
Next
For InxF = 1 To FldrPrnt.Folders.Count
If FldrPrnt.Folders(InxF).DefaultItemType = olMailItem Then
Call ProcessChild(FldrPrnt.Folders(InxF), Indent + 1)
End If
Next
End Sub
You need to iterate over all folders recursively:
Private Sub processFolder(ByVal oParent As Outlook.MAPIFolder)
Dim oFolder As Outlook.MAPIFolder
Dim oMail As Outlook.MailItem
For Each oMail In oParent.Items
'Get your data here ...
Next
If (oParent.Folders.Count > 0) Then
For Each oFolder In oParent.Folders
processFolder oFolder
Next
End If
End Sub
Also, you may consider using the AdvancedSearch method of the Application class which performs a search based on a specified DAV Searching and Locating (DASL) search string. The key benefits of using the AdvancedSearch method in Outlook are:
The search is performed in another thread. You don’t need to run another thread manually since the AdvancedSearch method runs it automatically in the background.
Possibility to search for any item types: mail, appointment, calendar, notes etc. in any location, i.e. beyond the scope of a certain folder. The Restrict and Find/FindNext methods can be applied to a particular Items collection (see the Items property of the Folder class in Outlook).
Full support for DASL queries (custom properties can be used for searching too). You can read more about this in the Filtering article in MSDN. To improve the search performance, Instant Search keywords can be used if Instant Search is enabled for the store (see the IsInstantSearchEnabled property of the Store class).
You can stop the search process at any moment using the Stop method of the Search class.
Read more about the AdvancedSearch method in the Advanced search in Outlook programmatically: C#, VB.NET article.
So, maybe you don't need to iterate over all folders and search for specific items there any longer?

Delete Old Emails From Shared Mailbox that contains over 300K items

I need to permanently delete emails from a shared mailbox that are older than a certain age.
The AutoArchive function does not affect the shared mailbox, and every time I try to run a rule to do this, it fails and does not take any action.
I've been manually clearing hundreds of emails from which takes an absolute age (when you have over 300k sitting in there), as it fills up my own deleted items when I do.
Edit:
I've been chopping up random bits of code I've found to try and achieve this. I have access to 6 other shared mailboxes within my department. I've been looking at the GetSharedDefaultFolder function but it is not very well explained and normally errors when my bodged attempt runs. I am not sure what it wants in the recipient function, as I have tried the mailbox name and address. The MS online resources aren't very helpful in this case:
Edit 2:
I have edited my code to the below. In this version I get an Overflow error on the line For intCount = olSharedBox.Items.Count To 1 Step -1.
Since there are over 300k emails in that box I think it is now looking at the right thing but not sure of a way around it. Is it not possible to get the current number from the pre-counted figure that appears next to the inbox?
Sub DeleteOldSharedMail()
Dim olApp As Outlook.Application
Dim olNS As Outlook.NameSpace
Dim olMailItem As Outlook.MailItem
Dim objVariant As Variant
Dim lngMovedItems As Long
Dim intCount As Integer
Dim intDateDiff As Integer
Dim olSharedBox As Folder
Dim mbOwner As Outlook.Recipient
Set olApp = Outlook.Application
Set olNS = olApp.GetNamespace("MAPI")
Set mbOwner = olNS.CreateRecipient("mailbox#email.com")
Set olSharedBox = olNS.GetSharedDefaultFolder(mbOwner, olFolderInbox)
For intCount = olSharedBox.Items.Count To 1 Step -1
Set objVariant = olSharedBox.Items.Item(intCount)
DoEvents
If objVariant.Class = olMail Then
intDateDiff = DateDiff("d", objVariant.SentOn, Now)
' Set number of days
If intDateDiff > 180 Then
objVariant.Delete
Call ClearDeletedFolder ' Working. Will change to call every 100 emails deleted after first run.
'count the # of items moved
lngMovedItems = lngMovedItems + 1
' No need to run the IF statement on the rest of the mailbox assuming the macro runs from oldest to newest.
'Else: GoTo Marker
End If
End If
Next
' Display the number of items that were moved.
Marker:
MsgBox "Moved " & lngMovedItems & " messages(s)."
End Sub
You can use the NameSpace.GetSharedDefaultFolder method to get at the Inbox to delete items. However, if the items are in another folder you will need Full Mailbox access to that mailbox or write permissions on the specific folders. In those cases you will need to find the folders in that mailbox IF that mailbox has also been added to the current Outlook profile. Then you can access the folders from the matching Store object in NameSpace.Stores (e.g. via Store.GetDefaultFolder or .GetRootFolder, then "walk" through Folder.Folders collections).
Regardless, there is on way to permanently delete an email immediately in the Outlook Object Model. But you can delete it twice if you find it again in the Deleted Items folder.
See also:
How to: Delete All Items and Subfolders in the Deleted Items Folder

Outlook VBA - Bulk Move of Email Between Subfolders

I routinely have to move a decent amount of email (150+) from a subfolder to another. There are many folders in the mailbox that I perform this task on. It seems like it would be an easy macro to write, but what I have is substantially slower than doing a Ctrl+A, drag to destination folder.
I have reviewed previous questions about moving Outlook emails and Microsoft's documentation, but I am unable to figure out how to accomplish moving the emails in a a fast and reliable manner. I would appreciate any information on where I am going wrong and if there is another solution besides VBA.
My current code is below. My end goal would be to loop through a list of folder names (instead of me selecting the folder).
Thanks in advance.
Sub MoveEmailsToDone()
On Error Resume Next
Dim ns As Outlook.NameSpace
Dim AnalystFolder As Outlook.MAPIFolder
Dim MoveToFolder As Outlook.MAPIFolder
Set ns = Application.GetNamespace("MAPI")
Set AnalystFolder = Application.ActiveExplorer.CurrentFolder
Set MoveToFolder = ns.Folders("username#domain.com").Folders(AnalystFolder.Name & "-DONE")
For i = AnalystFolder.Items.Count To 1 Step -1
AnalystFolder.Items(i).Move MoveToFolder
Next i
Set ns = Nothing
Set AnalystFolder = Nothing
Set MoveToFolder = Nothing
End Sub
From experience Move and Delete are slow.
http://computer-programming-forum.com/1-vba/17216b85e9c096d3.htm
07 Jul 2003
The following code loops through each mail item in a specified folder
and moves the item to another folder. For 1100 items, it takes more
than 5 min. It doesn't move that slow when I select all and move in
the user interface.
.
Outlook uses Extended MAPI to implement a move operation, namely
IMAPIFolder::CopyMessages() which takes a list of entryids, hence it does not
need to open each message. Store provider completes the whole operation on the
server without sending lots of data back and forth as apparently happens when
you run your code.
Dmitry Streblechenko
https://stackoverflow.com/users/332059/dmitry-streblechenko
DoEvents lets you use Outlook while the code runs.
For i = AnalystFolder.Items.Count To 1 Step -1
DoEvents
AnalystFolder.Items(i).Move MoveToFolder
Next i
MsgBox "MoveEmailsToDone is finally done."

reply with template in outlook 2010

As a continuous process to improve our customer service at our helpdesk I'm looking to integrate a functionality in our outlook so that we can reply to existing e-mails using outlook template's (.oft).
My search online mostly gave me results for auto-reply'ing. However this is not what I (we) need.
We are in need for a tool that enables us to select from a list of standard templates (with subject oriented reply's). http://replywith.4team.biz/ Gives a solution in the right direction, however, as with any company, we would like a free tool.
Is this programmable in VBA? And if so, how?
Ours not to reason why, ours but to do and die.
Here is one small, untested, VBA sample based on http://msdn.microsoft.com/en-us/library/office/ff865637.aspx
Sub CreateReplyFromTemplate()
dim currItem As Outlook.MailItem
dim currItemReply As Outlook.MailItem
Dim MyItem As Outlook.MailItem
set currItem = activeinspector.currentitem
Set curritemReply = currItem.Reply
Set MyItem = Application.CreateItemFromTemplate("C:\HelpTopic1.oft")
MyItem.To = currItemReply.To
MyItem.htmlbody = MyItem.htmlbody & currItemReply.htmlbody
currItemReply.close oldiscard
currItem.close oldiscard
MyItem.Display
set curritemReply = nothing
set MyItem = nothing
set currItem = nothing
End Sub
For ways of deploying the VbaProject.OTM file http://www.outlookcode.com/article.aspx?id=28 or see if this works VbaProject.OTM deployment
Alternatively, the free version is built into Outlook.
Reply with a message template via Quick Steps - http://www.msoutlook.info/question/665
Working with message templates - http://www.howto-outlook.com/howto/messagetemplates.htm
If training for this is available, the cost of one day of training for each person could be $300.00 or more.
Of course you can do that in VBA, but would you really want to? You can buy 10 licenses of that tool for $99.50. I don't know where you work, but at most software companies $99.50 will buy you about an hour worth of programmer's time (benefits included). You probably could have bought 1 license if you saved the time it took you to post this question.
Just to add to the answer above, in sub CreateReplyFromTemplate() instead of
Set curritemReply = currItem.Reply
Replace with
Set currItem = Application.ActiveExplorer().Selection(1)

Move Outlook messages if content contains a number greater than threshold

I get thousands of Nagios alerts in my inbox daily, but many of them are actually trivial (even though Nagios reports them as critical). I want to check whether the text of these alerts contains numbers above a certain threshold; if the numbers are lower than that threshold, move the message to a junk folder. I should really work with my sysadmin to decrease the number of useless alerts Nagios sends in the first place, but humor me in my attempt at a creative workaround.
I'm using Outlook 2007 and have found several tutorials on writing Outlook macros in VB, including this one about programmatically creating a rule to move messages to different folders. That example uses a TextRuleCondition to check whether the subject contains any of the keywords in an array.
But I don't want to check for keywords, I want to check if a number in the message text is greater or less than a threshold value. For example, if the text of a message contains the following, it could be moved to a junk folder:
Nagios bad condition: foo = 3
But if a message contained this, I would want to keep it:
Nagios bad condition: foo = 157
This example seems a little more like what I want in terms of searching the content of the message for arbitrary text. But it requires the message to be open, so I'm not quite sure how to translate it into a rule. Any help would be appreciated.
The second example you link to will put you on the right track to write code that discriminates between good and junk e-mails.
Then you will want to put that code in the _ItemAdd event for the Inbox items, such that it runs every time something new pops up in your Inbox. Here's an example of what should go in your Outlook VBA module:
Public WithEvents myOlItems As Outlook.Items
Public Sub Application_Startup()
' Upon starting Outlook, set reference to the items in the Inbox.
Set myOlItems = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Items
End Sub
Private Sub myOlItems_ItemAdd(ByVal Item As Object)
' Because myOlItems is declared "WithEvents",
' the ItemAdd event will fire anytime something new pops up in the Inbox.
If TypeName(Item) = "MailItem" Then
' It's an e-mail.
' Here goes the code to test whether it should go to the junk folder.
Else
' It's something else than an e-mail.
' Do nothing.
End If
End Sub
JFC has already given you one way. Here is another using RULES to check messages as they arrive. Do this.
Open VBA Editor and paste this code in ThisOutlookSession
UNTESTED
Option Explicit
Sub Sample(MyMail As MailItem)
Dim strID As String, olNS As Outlook.NameSpace
Dim objInboxFolder As Outlook.MAPIFolder
Dim objDestinationFolder As Outlook.MAPIFolder
Dim olMail As Outlook.MailItem
Dim strFileName As String, strSubj As String
Dim Myarray() As String
Dim ThrsdVal As Long
strID = MyMail.EntryID
Set olNS = Application.GetNamespace("MAPI")
Set olMail = olNS.GetItemFromID(strID)
'~~> Email Subject
strSubj = olMail.Subject
'~~> Threshold value
ThrsdVal = 100
'Nagios bad condition: foo = 3
Myarray = Split(strSubj, "=")
Set objInboxFolder = olNS.GetDefaultFolder(olFolderInbox)
'~~> Destination folder
Set objDestinationFolder = objInboxFolder.Folders("Temp")
'~~> Check if less than threshold value
If Val(Trim(Myarray(1))) < ThrsdVal Then
olMail.Move objDestinationFolder
End If
Set olMail = Nothing
Set olNS = Nothing
End Sub
Now
1) Create a new Rule (Select "Check Messages When they Arrive")
2) In (Condition) select "From people or Distribution List"
3) Select the relevant email address from which you are getting the emails
4) In Actions, select "run a script" and then choose the above script.
5) Finally click on Finish and you are done :)
The best part about this is that you can run this rule for existing emails in your inbox folder as well :)
NOTE: Like I mentioned above, I have not tested the code so do let me know if you get any errors and I will rectify it. Also I am assuming that the message will have a subject with the format as "Nagios bad condition: foo = X". I have not included any error handling. I am sure you can take care of that :)
HTH
Sid