Outlook Tracker for shared mailbox - vba

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.

Related

Run a script is running on old mail before new email moved to the target folder

I created a rule to move a daily email to a specific folder and run a VBA script to save the table from this email's body.
When the email is received, VBA starts running and grabbing previous email with the same subject and only after does the new email appear in my target folder.
I tried sleep.
Is there any way to first move new email to a target folder then run a script?
Sub ExportOutlookTableToExcel()`
Dim oLookInspector As Inspector
Dim oLookMailitem As MailItem
Dim oLookWordDoc As Word.Document
Dim oLookWordTbl As Word.Table
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlWrkSheet As Excel.Worksheet
'Grab Email Item
Set oLookMailitem =Application.ActiveExplorer.CurrentFolder.Items("Apples Sales")
Set oLookInspector = oLookMailitem.GetInspector
Set oLookWordDoc = oLookInspector.WordEditor
Re: I created a rule to move this email to a specific folder and run a VBA script
You are not the first to fall into this trap. Put the move as the last action in the code.
Consider not using "run a script" code in rules. There is ItemAdd for any folder or NewMailEx for the Inbox.
Re: Set oLookMailitem =Application.ActiveExplorer.CurrentFolder.Items("Apples Sales")
The most recent mail with subject "Apples Sales" can be found like this:
Option Explicit ' Consider this mandatory
' Tools | Options | Editor tab
' Require Variable Declaration
' If desperate declare as Variant
Sub mostRecentlyReceivedMail_Subject_DemoOnly()
Dim oLookFolder As Folder
Dim oLookFolderItems As Items
Dim srchSubject As String
Dim i As Long
Dim oLookMailitem As MailItem
Set oLookFolder = ActiveExplorer.CurrentFolder
Set oLookFolderItems = oLookFolder.Items
' sort the collection not the folder
oLookFolderItems.Sort "[ReceivedTime]", True
srchSubject = "Apples Sales"
' This is demonstration code only.
' Without introducing methods to reduce the number of items to look through
' it shows the use of an index rather than subject.
' In this case the required item is supposed to be first in the collection.
For i = 1 To oLookFolderItems.Count
' first verify object in folder is a mailitem
If oLookFolderItems(i).Class = olMail Then
' Index not subject
Set oLookMailitem = oLookFolderItems(i)
If oLookMailitem.subject = srchSubject Then
Debug.Print oLookMailitem.ReceivedTime
oLookMailitem.Display
Exit For
End If
End If
Next
End Sub
Although subject is valid in
Set oLookMailitem =Application.ActiveExplorer.CurrentFolder.Items("Apples Sales")
it probably has little to no practical use.
I creted a rule to move this email to a specific folder and run a vba script to save the table from this new emails body.
There is no need to create a rule and run a VBA script. Instead, to handle incoming emails immediately you need to handle the NewMailEx event which is fired when a new message arrives in the Inbox and before client rule processing occurs. You can use the Entry ID returned in the EntryIDCollection array to call the NameSpace.GetItemFromID method and process the item. Use this method with caution to minimize the impact on Outlook performance. However, depending on the setup on the client computer, after a new message arrives in the Inbox, processes like spam filtering and client rules that move the new message from the Inbox to another folder can occur asynchronously. You should not assume that after these events fire, you will always get a one-item increase in the number of items in the Inbox. Also you may consider handling the ItemAdd event on the folder where your items are moved. But it has a known disadvantage - the event is not fired if more than sixteen items are moved at the same time. This is a known issue when dealing with OOM.
In the NewMailEx event handler you may get an instance of the incoming email and move it to the required folder programmatically where you could run any other actions.

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?

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."

Using VBA in Outlook to gather statistics on received emails

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

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