Using VBA in Outlook to gather statistics on received emails - vba

At work we use a shared Outlook mailbox to receive emails from our users, and at the moment we have a rota of who's turn it is to monitor the mailbox and reply etc. Our working hours have been 7am-5pm since we started the email address.
For the next 2 months we're trailing a change in hours where we (or should I say, myself only) will be monitoring the mailbox up until 11pm.
What I'd like to do is gather some statistics on the emails we receive to see if it is worth it from a business view to keep the later shift on after the trail.
What I was thinking of doing is using some VBA to check the emails in the inbox, and then break the data down into some stats for management, eg:
Monday 06/05/12:
49 emails received, 34 were replies, 15 were new
At 7am received: 0 emails
At 8am received: 1 emails
------
At 11pm received: 0 emails
etc
To work out if an email is an original or reply I think it's easiest to see if the subject starts with RE:? (I know it's not foolproof but I think it'll work for basic stats)
Has anyone done anything like this before? Is there an easy/right way of doing it?
Anyone got any tips/code samples that would be useful?

You could start with something like this
Sub EmailStats()
Dim olMail As MailItem
Dim aOutput() As Variant
Dim lCnt As Long
Dim xlApp As Excel.Application
Dim xlSh As Excel.Worksheet
Dim flInbox As Folder
Set flInbox = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
ReDim aOutput(1 To flInbox.Items.Count, 1 To 4)
For Each olMail In flInbox.Items
If TypeName(olMail) = "MailItem" Then
lCnt = lCnt + 1
aOutput(lCnt, 1) = olMail.SenderEmailAddress 'maybe stats on domain
aOutput(lCnt, 2) = olMail.ReceivedTime 'stats on when received
aOutput(lCnt, 3) = olMail.ConversationTopic 'group based on subject w/o regard to prefix
aOutput(lCnt, 4) = olMail.Subject 'to split out prefix
End If
Next olMail
Set xlApp = New Excel.Application
Set xlSh = xlApp.Workbooks.Add.Sheets(1)
xlSh.Range("A1").Resize(UBound(aOutput, 1), UBound(aOutput, 2)).Value = aOutput
xlApp.Visible = True
End Sub
If you want to add more data, just change the Redim statement to accommodate more columns and add them in the If block. Once in Excel (or maybe Access or SQLServer if it's a lot of data), you can add a few calculations, like
=IF(LEFT(#Subject,3)="RE:","Reply",IF(LEFT(#Subject,3)="FW:","Forward","Original"))
Then pivot like crazy.
You need a reference to the Excel object library for the above code to work.

I'd take a step back further and use the log files from the mail server to answer this question.
Once a day, you could simply pull a report of all emails received by the mailbox. If you don't personally have access to them, then your mail administrator should.

There is this nice tool called OutlookStatView made by the awesome guys at NirSoft.
screenshot sample:
if you are not so keen on using VBA, please try using the advanced filtering options available for the same, using it you can select specific folders, and start datetime and end datetime for your monitoring.
Note: this won't be realtime or automated, it is all a manual way to demonstrate the possibilities.
mailbox scan options:
Runs on Windows 2000/XP/Vista/2003/2008/7/8/10.
Supports Any version of Microsoft Outlook, including Outlook 2016.
I'm looking for Mac & Linux alternatives.
this answer is similar but not same as https://superuser.com/a/1226613/249975

Related

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)

Outlook Tracker for shared mailbox

We use a shared outlook mailbox, we receive 1000 emails daily, is there any macro which would provide us the details of item replied at what time and those items which were not replied. Basicallly we need to track the time taken to reply a particular inbox item.
There is no macro, but you can write your own. Outlook -> Tools -> Macro -> Visual Basic Editor.
In VBA, you have to start an Outlook.MAPIFolder object and hook it up to the desired mailbox.
Dim f As MAPIFolder
Dim olns As Outlook.NameSpace
Set olns = Outlook.GetNamespace("MAPI")
Set f = olns.Folders("Mailbox - Name, Name")
Set f = f.Folders("Inbox")
If you are examining a subfolder within the mailbox, you'll need to do this:
Set f = f.Folders("Name of the subfolder")
Then you need to iterate through the items.
Dim m As MailItem
Dim i As Long
i = 1
Do Until i > f.Items.Count
If f.Items(i).Class = olMail Then
Set m = f.Items(i)
End If
' yada yada
i = i + 1
DoEvents
Loop
How you detect which have been replied to will depend on what version of Outlook you are using. For Outlook 2007, you can use Outlook.PropertyAccessor. For earlier versions, you can use a third-party add-in like Redemption, or you can resort to something like comparing m.LastModificationTime and m.CreationTime.
For example:
If m.LastModificationTime - m.CreationTime < 0.1 Then
n = n + 1
Debug.Print m.subject
End If
The times will always be a little tiny bit off, so you can't use "=", you have to check whether the difference is really small.
This may pick up emails which are forwarded as well as emails which are replied to; consider whether this is what you want.
If this is still actual, I'd suggest to use Excel's Power Query to track conversations. Basically, all you need is to aggregate your list of items by Conversation ID and then take Received Time of first and second items of each conversation. Make sure to sort nested tables either by Received Time or Conversation Index.

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